Информация о форуме
Администратор: root
Модератор(ы): Mikes, Lurid, Kiddy
Всего тем: 20

Вы можете читать форум
Вы не можете отправлять сообщения
Вы не можете открывать новые темы

Форум: Soft & Warez
все о программах, новых и старых
венн_BDS2005 : Delphi
венн
15.12.06 12:34 		для того, чтобы использовать переменные типа OleVariant в
раздел uses надо добавить модули ActiveX и ComObj
warlock
06.01.07 01:07 		кому небезынтересно - добавьте в OnCreate:)
предварительно сделав так:
...
type
TForm1 = class(TForm)
procedure FormShape;
...


procedure TForm1.FormShape;
var
RectRgnH, RectRgnV: HRGN;
RndRgnTL, RndRgnTR, RndRgnBL, RndRgnBR: HRGN;
Rds: integer;
begin
Rds := 32;

RectRgnH := CreateRectRgn(0, Round(Rds/2), Width, Height -
Round(Rds/2));
RectRgnV := CreateRectRgn(Round(Rds/2), 0, Width -
венн
19.01.07 15:38 		как узнать время изменения файла? вот так -
ftLastWriteTime.
так же можно использовать ftLastAccessTime и ftCreationTime
(время доступа и время создания, соответственно).

function GetFileDateTime(fPathName: string): string;
var
fFile: THandle;
filTime: _FILETIME;
locTime: _FILETIME;
sysTime: _SYSTEMTIME;
fDateTime: string;
ffData: WIN32_FIND_DATA;
fDate: string;
fTime: string;
begin
fFile := Windows.
FindFirstFile(PChar(fPathName),ffData);
if fFile = INVALID_HANDLE_VALUE then begin

Application.MessageBox('Ошибка!',PChar(Application.Title),
MB_OK);
Exit;
end;
filTime := ffData.ftLastWriteTime;
Windows.FindClose(fFile);
FileTimeToLocalFileTime(filTime,locTime);
FileTimeToSystemTime(locTime, sysTime);
fDate := DateToStr(EncodeDate(sysTime.wYear,
sysTime.wMonth,
sysTime.wDay));
fTime := TimeToStr(EncodeTime(sysTime.wHour,
sysTime.wMinute,
sysTime.wSecond,
sysTime.wMilliseconds));
fDateTime := {fDate+' '+}fTime;
GetFileDateTime:=fDateTime;

end;
AndrЮshkA
22.01.07 17:33 		unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms,
Dialogs, StdCtrls, FileCtrl, Masks;

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
Button2: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Text: string;
procedure Scan (s: string);
procedure Search;

implementation

{$R *.DFM}

procedure Scan(s: string);
var
sr: TSearchRec;

r: integer;
OldDir: string;
begin
{$I-}
ChDir (s);
{$I+}
if IoResult = 0 then begin
try
r := FindFirst ('*.*', faAnyFile, sr);
while r = 0 do begin
if (sr.Name <> '.') and (sr.Name <> '..') then
begin
Form1.Label1.Caption := ExpandFileName (sr.Name);
Form1.Label1.Update;
if (faDirectory and sr.Attr) = faDirectory then
begin
OldDir := GetCurrentDir;
Scan (ExpandFileName (sr.Name));
ChDir (OldDir);
end else begin
if MatchesMask (sr.Name, Form1.Edit1.Text) then
// вот тут мне надо чтоб данные можно было писать в файл

Form1.Memo1.Lines.Add(ExpandFileName (sr.Name));
end;
end;
r := FindNext (sr);
end;
finally
FindClose (sr);
end;
end;
end;

procedure Search;
var
DriveNum: Integer;
DriveChar: Char;
DriveBits: set of 0..25;

begin
Integer(DriveBits) := GetLogicalDrives;
for DriveNum := 0 to 25 do begin
if not (DriveNum in DriveBits) then
Continue;
DriveChar := Char(DriveNum + Ord('C'));
Scan (DriveChar + ':\');
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Search;
end;

procedure TForm1.Button2Click(Sender: TObject);
Var
F:TextFile;
begin
AssignFile(f,'C:\Files.txt');
Rewrite(f);
Write (f,Form1.Memo1.text);
Closefile(f);
end;

end.
венн
23.01.07 08:40 		попробуй вот так сделать.
только с формы кнопку "Записать" убери (не нужна она) :)

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms,
Dialogs, StdCtrls, FileCtrl, Masks, ExtCtrls;

type
TForm1 = class(TForm)
Memo1: TMemo;
Panel1: TPanel;
Label1: TLabel;
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure Scanning (s: string);
procedure Searching;
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Text: string;
F:TextFile;

implementation

{$R *.DFM}

procedure TForm1.Scanning(s: string);
var
sr: TSearchRec;
r: integer;
OldDir: string;
ExpFileName: string;
begin
{$I-}
ChDir(s);
{$I+}
if IoResult = 0 then begin
try
r := FindFirst ('*.*', faAnyFile, sr);
while r = 0 do begin
if (sr.Name <> '.') and (sr.Name <> '..') then
begin
Form1.Label1.Caption := ExpandFileName (sr.Name);
Form1.Label1.Update;
if (faDirectory and sr.Attr) = faDirectory then
begin
OldDir := GetCurrentDir;
Scanning (ExpandFileName (sr.Name));
ChDir (OldDir);
end else begin
if MatchesMask (sr.Name, Form1.Edit1.Text) then
ExpFileName:=ExpandFileName(sr.Name);
WriteLn (f,ExpFileName);
Form1.Memo1.Lines.Add(ExpFileName);
end;
end;
r := FindNext (sr);
end;
finally
FindClose (sr);
end;
end;
end;

procedure TForm1.Searching;
var
DriveNum: Integer;
DriveChar: Char;
DriveBits: set of 0..25;
begin
Integer(DriveBits) := GetLogicalDrives;
for DriveNum := 0 to 25 do begin
if not (DriveNum in DriveBits) then
Continue;
DriveChar := Char(DriveNum + Ord('C'));
Scanning(DriveChar + ':\');
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
AssignFile(f,'Files.txt');
try
{$I-}
Rewrite(f);
{$I+}
if IOResult = 0 then Searching;
finally
CloseFile(f);
end;
end;

end.
венн
23.01.07 09:56 		а еще можешь поменять процедуру Searching вот так:

procedure TForm1.Searching;
var
arrDrives: array[1..26] of char;
i: integer;
chDrive: char;
begin
arrDrives := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
for i := 1 to 26 do
if GetDriveType(PChar(arrDrives[I]+':\')) <> (0 or 1)
then begin
chDrive := arrDrives[i];
Scanning(chDrive + ':\');
end;
end;

если в маске поиска указать '*.*', то при таком раскладе
идет поиск фсех файлов по всем доступным дискам (включая
дискеты, CDROM'ы (есди вставлены в дисководы) и сетевые
(ежели подключены)), а прежняя процедура Searching
производила поиск только на том диске, на котором находился
исполняемый файл программы.
венн_pacific
06.02.07 00:49 		Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey('\Software\MailExchange2003', true);
Dir := Reg.ReadString('InPath');
finally
Reg.Free;
end;
warlock
18.02.07 22:48 		>AndrЮshkA
почитай здесь про OLE (ворд и БД). очень пользительно для
тебя будет
http://www.delphimaster.ru/articles/dbtoword/index.html
AndrЮshkA
10.04.07 13:48 		Data = record
url,text:string;

min,
shag,
cena,:integer;
vremya:tdatetime;
end;

var
F: file of data; // вот тут ругается
l:data;
венн
11.04.07 22:55 		AndrЮshkA: (10.04.07 13:48)
Data = record
url,text:string;

min,
shag,
cena,:integer;
vremya:tdatetime;
end;

var
F: file of data; // вот тут ругается
l:data;
 ты бы еще написал сюда - что в сообщении об ошибке
выводится...

а так - попробуй поменять имя переменной Data на что-нить
другое