- Details
- Written by: Stanko Milosev
- Category: Delphi
- Hits: 4637
One piece of code which is not working anymore, not sure why, problem is probably somewhere in line: MyStream.WriteBuffer(Pointer(String2BeSaved)^,Length(String2BeSaved)); but I just don't want to loose it. Originally writen by Written by G.A. Carpenter, and original you see here.
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, shellapi; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); Procedure Add2File(DemarcStr,FileName,String2Add: String); Function File2String(FileName: String):String; Procedure String2File(String2BeSaved,FileName: String); Procedure ExtractAndStrip(DemarcStr,FileName: String); Procedure ExtractFromExe(DemarcStr: String; var ExtractedStr: String); Procedure DelFromString(DemarcStr: String; var String2Change: String); Procedure AddFile2Exe(DemarcStr,FileName: String); private procedure ReadExe; Procedure Add2String(DemarcStr,String2Add: String;var String2Alter: String); Procedure AlterExe; { Private declarations } public { Public declarations } end; var Form1: TForm1; exe: String; implementation {$R *.DFM} { TForm1 } procedure TForm1.ReadExe; Var ExeStream: TFileStream; begin ExeStream:=TFileStream.Create(Application.ExeName,fmOpenRead or fmShareDenyNone); Try SetLength(Exe, ExeStream.Size); ExeStream.ReadBuffer(Pointer(Exe)^, ExeStream.Size); Finally ExeStream.Free; end; end; procedure TForm1.Add2File(DemarcStr, FileName, String2Add: String); var MyString: String; begin MyString := File2String(FileName); MyString := MyString+uppercase('so!#'+DemarcStr)+String2Add+uppercase('eo!#'+DemarcStr); String2File(MyString,FileName); end; function TForm1.File2String(FileName: String): String; var MyStream: TMemoryStream; MyString: String; begin MyStream := TMemoryStream.Create; try MyStream.LoadFromFile(FileName); MyStream.Position := 0; SetLength(MyString,MyStream.Size); MyStream.ReadBuffer(Pointer(MyString)^,MyStream.Size); finally MyStream.Free; end; Result := MyString; end; procedure TForm1.String2File(String2BeSaved, FileName: String); Var MyStream: TMemoryStream; begin if String2BeSaved = '' then exit; SetCurrentDir(ExtractFilePath(Application.ExeName)); MyStream := TMemoryStream.Create; try MyStream.WriteBuffer(Pointer(String2BeSaved)^,Length(String2BeSaved)); MyStream.SaveToFile(FileName); finally MyStream.Free; end; end; procedure TForm1.ExtractAndStrip(DemarcStr, FileName: String); Var Temp: String; begin ExtractFromExe(DemarcStr,Temp); DelFromString(DemarcStr,Exe); String2File(Temp,FileName); end; procedure TForm1.ExtractFromExe(DemarcStr: String; var ExtractedStr: String); Var d,e: integer; begin if Length(Exe) = 0 then ReadExe; if Pos(uppercase('so!#'+DemarcStr),Exe) > 0 then begin d := Pos(uppercase('so!#'+DemarcStr),Exe) +length(uppercase('so!#'+DemarcStr)); e := Pos(uppercase('eo!#'+DemarcStr),Exe); ExtractedStr := Copy(Exe,d,e-d); end; end; procedure TForm1.DelFromString(DemarcStr: String; var String2Change: String); var a,b: string; begin a := UpperCase('so!#'+DemarcStr); b := UpperCase('eo!#'+DemarcStr); delete(String2Change,pos(a,String2Change),(pos(b,String2Change) +length(b)-pos(a,String2Change))); end; procedure TForm1.AlterExe; begin If (Exe) <> '' then begin String2File(Exe,'temp0a0.exe'); ShellExecute(0, 'open', PChar('temp0a0.exe'), PChar(ExtractFilename(Application.ExeName)), nil, SW_SHOW); Application.Terminate; end; end; Procedure TForm1.Add2String(DemarcStr,String2Add: String;var String2Alter: String); begin String2Alter := String2Alter+uppercase('so!#'+DemarcStr) +String2Add+uppercase('eo!#'+DemarcStr); end; procedure TForm1.AddFile2Exe(DemarcStr, FileName: String); Var MyString: String; begin MyString := File2String(FileName); If Exe = '' then ReadExe; Add2String(DemarcStr,MyString,Exe); end; procedure TForm1.Button1Click(Sender: TObject); begin AddFile2Exe('gac1','d:\myfile.txt'); AlterExe; end; end.