delphi4arab منتديات دلفي للعرب

السلام عليكم
هذا برنامج للدمج الملفات
للامانة العلمية ليس من برمجتي

[صورة: 20120903141830.png]

القالب

PHP كود :
program Stub;

uses
  Windows, ShellAPI;

{$R *.res}

var
hFile, hMod, hRes, hLoad:   THandle;
dWritten, dSize:      DWORD;
pFileData, pTemp:     Pointer;
Count, i:             integer;
sTemp:                string;
sPath, sName:         string;

function GetTmpPath():string;
var
sBuff:    array[0..255] of char;
begin
  GetTempPath(255, sBuff);
  Result := sBuff;
end;

function GetWinPath():string;
var
sBuff:    array[0..255] of char;
begin
  GetWindowsDirectory(sBuff, 255);
  Result := sBuff;
end;

function GetSysPath():string;
var
sBuff:    array[0..255] of char;
begin
  GetSystemDirectory(sBuff, 255);
  Result := sBuff
end;

function StrToInt(S: String): Integer;
begin
  Val(S, Result, Result);
end;

function IntToStr(i: Integer): String;
begin
  Str(i, Result);
end;

begin
hMod := GetModuleHandle(nil);
hRes := FindResource(hMod, PChar('COUNT'), RT_RCDATA);
hLoad := LoadResource(hMod, hRes);
dSize := SizeofResource(hMod, hRes);

pTemp := LockResource(hLoad);
SetLength(sTemp, dSize);
Move(pTemp^, sTemp[1], dSize);
Count := StrToInt(sTemp);

For i := 1 to Count do
begin
  hMod := GetModuleHandle(nil);

  // Get FilePath
  hRes := FindResource(hMod, PChar('PATH' + IntToStr(i)), RT_RCDATA);
  hLoad := LoadResource(hMod, hRes);
  dSize := SizeofResource(hMod, hRes);
  pTemp := LockResource(hLoad);
  SetLength(sPath, dSize);
  Move(pTemp^, sPath[1], dSize);
  if sPath = 'Temp' then
    sPath := GetTmpPath + '\'
  else if sPath = 'Windows' then
    sPath := GetWinPath + '\'
  else if sPath = 'System' then
    sPath := GetSysPath + '\';

  // Get FileName
  hRes := FindResource(hMod, PChar('NAME' + IntToStr(i)), RT_RCDATA);
  hLoad := LoadResource(hMod, hRes);
  dSize := SizeofResource(hMod, hRes);
  pTemp := LockResource(hLoad);
  SetLength(sName, dSize);
  Move(pTemp^, sName[1], dSize);
  sPath := sPath + sName;

  // Get File Data
  hRes := FindResource(hMod, PChar('HH' + IntToStr(i)), RT_RCDATA);
  hLoad := LoadResource(hMod, hRes);
  dSize := SizeofResource(hMod, hRes);
  pFileData := LockResource(hLoad);

  // Write File Data And Execute
  hFile := CreateFile(PChar(sPath), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  SetFilePointer(hFile, 0, nil, FILE_BEGIN);
  WriteFile(hFile, pFileData^, dSize, dWritten, nil);
  CloseHandle(hFile);
  ShellExecute(0, nil, PChar(sPath), nil, nil, 1);

end;
end. 

الصانع

PHP كود :
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, HHUtils;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    popMain: TPopupMenu;
    Add1: TMenuItem;
    Remove1: TMenuItem;
    Clear1: TMenuItem;
    N1: TMenuItem;
    Build1: TMenuItem;
    N2: TMenuItem;
    Exit1: TMenuItem;
    OpenDlg: TOpenDialog;
    SaveDlg: TSaveDialog;
    Extraction1: TMenuItem;
    emp1: TMenuItem;
    Windows1: TMenuItem;
    System1: TMenuItem;
    About1: TMenuItem;
    procedure Add1Click(Sender: TObject);
    procedure Remove1Click(Sender: TObject);
    procedure Clear1Click(Sender: TObject);
    procedure Build1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure emp1Click(Sender: TObject);
    procedure Windows1Click(Sender: TObject);
    procedure System1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  StubPath:  string;
  OutputPath: string;

implementation

{$R *.dfm}

function GetMyPath():string;
var
sBuff:  array[0..255] of char;
begin
  GetCurrentDirectory(255, sBuff);
  Result := sBuff;
end;

procedure TForm1.Add1Click(Sender: TObject);
begin
OpenDlg.Filter := 'All Files (*.*) | *.*';
OpenDlg.Title  := 'Please select a file...';
OpenDlg.Execute;

if FileExists(OpenDlg.FileName) then
  with Form1.ListView1.Items.Add do
  begin
    Caption:= OpenDlg.FileName;
    SubItems.Add(ExtractFileName(OpenDlg.FileName));
    SubItems.Add('Temp');
  end;
end;

procedure TForm1.Remove1Click(Sender: TObject);
begin
Listview1.DeleteSelected;
end;

procedure TForm1.Clear1Click(Sender: TObject);
begin
Listview1.Clear;
end;

procedure TForm1.Build1Click(Sender: TObject);
var
hFile:      THandle;
pFileBuff:  Pointer;
sFileCount: string;
sPath:      string;
sFileName:  string;
dSize:      DWORD;
dRead:      DWORD;
Count:      integer;
begin
  // Get stub data
  WriteFileFromPointer(ReadFileToMem(StubPath), OutputPath);

  For Count := 0 to Listview1.Items.Count - 1 do
  begin
    // Get File Data
    pFileBuff := ReadFileToMem(Listview1.Items[Count].Caption);
    UpdateFileResources(OutputPath, pFileBuff, RT_RCDATA, PChar('HH' + IntToStr(Count + 1)), FALSE);
    // Get FileName
    sFileName := Listview1.Items[Count].SubItems[0];
    UpdateFileResourcesFromString(OutputPath, sFileName, RT_RCDATA, PChar('NAME' + IntToStr(Count + 1)), FALSE);
    // Get FilePath
    sPath := Listview1.Items[Count].SubItems[1];
    UpdateFileResourcesFromString(OutputPath, sPath, RT_RCDATA, PChar('PATH' + IntToStr(Count + 1)), FALSE);
  end;
  sFileCount := IntToStr(Listview1.Items.Count);
  UpdateFileResourcesFromString(OutputPath, sFileCount, RT_RCDATA, PChar('COUNT'), FALSE);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
StubPath := GetMyPath + '\stub.exe';
OutputPath := GetMyPath + '\output.exe';
end;

procedure TForm1.emp1Click(Sender: TObject);
begin
Listview1.Selected.SubItems[1] := 'Temp';
end;

procedure TForm1.Windows1Click(Sender: TObject);
begin
Listview1.Selected.SubItems[1] := 'Windows';
end;

procedure TForm1.System1Click(Sender: TObject);
begin
Listview1.Selected.SubItems[1] := 'System';
end;

procedure TForm1.About1Click(Sender: TObject);
begin
MessageBox(0, PChar('Open Source Code Binder 1.0'#10#13#10#13'By steve10120'#10#13#10#13'http://hackhound.org'), PChar('About'), MB_ICONINFORMATION);
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
Halt(0);
end;

end. 

مرفق unit HHUtils

لم يشتغل معي السورس

يا اخى انا حاولت اعمل البرنامج و لم استطيع هل من مثال كامل و لك الشكر

onexite

issam-escobar

khalmoh1971