قرار دادن يك فايل Exe درون برنامه و اجراي آن
قرار دادن يك فايل Exe درون برنامه و اجراي آن
کد:
var
Form1: TForm1;
NOTEPAD_FILE: string;
implementation
{$R *.DFM}
{$R MYRES.RES}
function GetTempDir: string;
var
Buffer: array[0..MAX_PATH] of Char;
begin
GetTempPath(SizeOf(Buffer) - 1, Buffer);
Result := StrPas(Buffer);
end;
// Extract the Resource
function ExtractRes(ResType, ResName, ResNewName: string): Boolean;
var
Res: TResourceStream;
begin
Result := False;
Res := TResourceStream.Create(Hinstance, Resname, PChar(ResType));
try
Res.SavetoFile(ResNewName);
Result := True;
finally
Res.Free;
end;
end;
// Execute the file
procedure ShellExecute_AndWait(FileName: string);
var
exInfo: TShellExecuteInfo;
Ph: DWORD;
begin
FillChar(exInfo, SizeOf(exInfo), 0);
with exInfo do
begin
cbSize := SizeOf(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
ExInfo.lpVerb := 'open';
lpFile := PChar(FileName);
nShow := SW_SHOWNORMAL;
end;
if ShellExecuteEx(@exInfo) then
begin
Ph := exInfo.HProcess;
end
else
begin
ShowMessage(SysErrorMessage(GetLastError));
Exit;
end;
while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do
Application.ProcessMessages;
CloseHandle(Ph);
end;
// To Test it
procedure TForm1.Button1Click(Sender: TObject);
begin
if ExtractRes('EXEFILE', 'TESTFILE', NOTEPAD_FILE) then
if FileExists(NOTEPAD_FILE) then
begin
ShellExecute_AndWait(NOTEPAD_FILE);
ShowMessage('Notepad finished!');
DeleteFile(NOTEPAD_FILE);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
NOTEPAD_FILE := GetTempDir + 'Notepad_FROM_RES.EXE';
end;
پاك كردن برنامه توسط خودش بعد از اجراي آن
پاك كردن برنامه توسط خودش بعد از اجراي آن
کد:
procedure DeleteEXE;
function GetTmpDir: string;
var
pc: PChar;
begin
pc := StrAlloc(MAX_PATH + 1);
GetTempPath(MAX_PATH, pc);
Result := string(pc);
StrDispose(pc);
end;
function GetTmpFileName(ext: string): string;
var
pc: PChar;
begin
pc := StrAlloc(MAX_PATH + 1);
GetTempFileName(PChar(GetTmpDir), 'uis', 0, pc);
Result := string(pc);
Result := ChangeFileExt(Result, ext);
StrDispose(pc);
end;
var
batchfile: TStringList;
batchname: string;
begin
batchname := GetTmpFileName('.bat');
FileSetAttr(ParamStr(0), 0);
batchfile := TStringList.Create;
with batchfile do
begin
try
Add(':Label1');
Add('del "' + ParamStr(0) + '"');
Add('if Exist "' + ParamStr(0) + '" goto Label1');
Add('rmdir "' + ExtractFilePath(ParamStr(0)) + '"');
Add('del ' + batchname);
SaveToFile(batchname);
ChDir(GetTmpDir);
ShowMessage('Uninstalling program...');
WinExec(PChar(batchname), SW_HIDE);
finally
batchfile.Free;
end;
Halt;
end;
end;
غير فعال كردن دكمه Close در فرم
غير فعال كردن دكمه Close در فرم
کد:
procedure TFMain.FormCreate(Sender: TObject);
var
hMenuHandle: Integer;
begin
hMenuHandle := GetSystemMenu(Handle, False);
if (hMenuHandle <> 0) then
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;
روش استفاده از TFileStream
روش استفاده از TFileStream
کد:
type
TPerson = record
Name: string[50];
vorname: string[50];
end;
TComputer = record
Name: string[30];
cpu: string[30];
end;
var
Form1: TForm1;
Person: TPerson;
Computer: TComputer;
Stream: TFileStream;
implementation
{$R *.DFM}
//Speichern resp. Erstellen von Datei
//Save or create the file
procedure TForm1.Button1Click(Sender: TObject);
begin
try
Stream := TFileStream.Create('c:\test.dat', fmOpenReadWrite);
except
Stream := TFileStream.Create('c:\test.dat', fmCreate);
end;
//2 Einträge pro Record
//save 2 records for TPerson and TComputer
Person.Name := 'Grossenbacher';
Person.vorname := 'Simon';
Stream.WriteBuffer(Person, SizeOf(TPerson));
Person.Name := 'Stutz';
Person.vorname := 'Thomas';
Stream.WriteBuffer(Person, SizeOf(TPerson));
Computer.Name := 'Delphi';
Computer.cpu := 'Intel';
Stream.WriteBuffer(Computer, SizeOf(TComputer));
Computer.Name := 'Win';
Computer.cpu := 'AMD';
Stream.WriteBuffer(Computer, SizeOf(TComputer));
Stream.Free;
end;
//lädt alle daten von TPerson in listbox1 und
//daten von TComputer in Listbox2
//load records from TPerson to listbox1 and
//load records from TComputer to listbox2
procedure TForm1.Button2Click(Sender: TObject);
var
i: Integer;
begin
try
// nur lesen öffnen
//open read only
Stream := TFileStream.Create('c:\test.dat', fmOpenRead);
except
ShowMessage('Datei konnte nicht geladen werden.');
Exit;
end;
//variable i auf anzahl Einträge setzen
//set variable i to the record count
//Einlesen von TPerson
//Read records TPerson
for i := 2 downto 1 do
begin
Stream.ReadBuffer(Person, SizeOf(TPerson));
Listbox1.Items.Add(Person.vorname + ' ' + Person.Name);
end;
//Einlesen von TComputer
//Read Records TComputer
for i := 2 downto 1 do
begin
Stream.ReadBuffer(Computer, SizeOf(TComputer));
Listbox2.Items.Add(Computer.Name + ' ' + Computer.cpu);
end;
Stream.Free;
end;
جايگزيني يك Dll در حال استفاده از آن
جايگزيني يك Dll در حال استفاده از آن
کد:
function SystemErrorMessage: string;
var
P: PChar;
begin
if FormatMessage(Format_Message_Allocate_Buffer + Format_Message_From_System,
nil,
GetLastError,
0,
@P,
0,
nil) <> 0 then
begin
Result := P;
LocalFree(Integer(P))
end
else
Result := '';
end;
// Path to Original File
procedure TForm1.Button2Click(Sender: TObject);
begin
if Opendialog1.Execute then
edit1.Text := OpenDialog1.FileName;
end;
// Path to New File
procedure TForm1.Button3Click(Sender: TObject);
begin
if Opendialog2.Execute then
edit2.Text := OpenDialog2.FileName;
end;
// Replace the File.
procedure TForm1.Button1Click(Sender: TObject);
begin
if (Movefileex(PChar(Edit1.Text), PChar(Edit2.Text), MOVEFILE_DELAY_UNTIL_REBOOT) = False) then
ShowMessage(SystemErrorMessage)
else
begin
ShowMessage('Please Restart Windows to have these changes take effect');
halt;
end;
end;
خواندن يك فايل متني بصورت خط به خط و تغيير آن
خواندن يك فايل متني بصورت خط به خط و تغيير آن
کد:
procedure TForm1.Button1Click(Sender: TObject);
var
i, z: Integer;
f: TextFile;
t: string;
Data: array of string;
begin
if OpenDialog1.Execute then
begin
//Read line by line in to the array data
AssignFile(f, OpenDialog1.FileName);
Reset(f);
z := 0;
SetLength(Data, 0);
//Repeat for each line until end of file
repeat
Inc(z);
readln(f, t);
SetLength(Data, Length(Data) + Length(t));
Data[z] := t;
until EOF(f);
SetLength(Data, Length(Data) + 3 * z);
//Add to each line the line number
for i := 1 to z do Data[i] := IntToStr(i) + ' ' + Data[i];
SetLength(Data, Length(Data) + 2);
//Add a carriage return and line feed
Data[1] := Data[1] + #13 + #10;
i := Length(Data[5]);
Data[5] := '';
SetLength(Data, Length(Data) - i);
//create a new textfile with the new data
AssignFile(f, OpenDialog1.FileName + '2');
ReWrite(f);
//write all lines
for i := 1 to z do writeln(f, Data[i]);
//save file and close it
CloseFile(f);
end;
end;
