Details

Written by: Stanko Milosev

Category: Delphi

Published: 28 December 2011

Last Updated: 30 November -0001

Hits: 4846

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.