HanDs
管理员

[Delphi文章] 加密捆绑工具源码 



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, Buttons;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Edt_File1: TEdit;
    Edt_File2: TEdit;
    Edt_File3: TEdit;
    Edt_File4: TEdit;
    Edt_File5: TEdit;
    btn_File1: TBitBtn;
    btn_File2: TBitBtn;
    btn_File3: TBitBtn;
    btn_File4: TBitBtn;
    btn_File5: TBitBtn;
    btn_Bundle: TBitBtn;
    od_File1: TOpenDialog;
    od_File2: TOpenDialog;
    od_File3: TOpenDialog;
    od_File4: TOpenDialog;
    od_File5: TOpenDialog;
    sd_bundle: TSaveDialog;
    Label6: TLabel;
    Label7: TLabel;
    procedure btn_File1Click(Sender: TObject);
    procedure btn_File2Click(Sender: TObject);
    procedure btn_File3Click(Sender: TObject);
    procedure btn_File4Click(Sender: TObject);
    procedure btn_File5Click(Sender: TObject);
    procedure btn_BundleClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
{$R BundleFile.RES}

function ExtractRes(ResType, ResName, OutName: string): Boolean;
var
  HResInfo: THandle;
  HGlobal: THandle;
  Ptr: Pointer;
  HFile: THandle;
  Size, N: Integer;
begin
  HFile := INVALID_HANDLE_VALUE;
  repeat
    Result := False;
    HResInfo := FindResource(HInstance, PChar(ResName), PChar(ResType));
    if HResInfo = 0 then Break;
    HGlobal := LoadResource(HInstance, HResInfo);
    if HGlobal = 0 then Break;
    Ptr := LockResource(HGlobal);
    Size := SizeOfResource(HInstance, HResInfo);
    if Ptr = nil then Break;
    HFile := CreateFile(PChar(OutName), GENERIC_READ or GENERIC_WRITE,
      0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    if HFile = INVALID_HANDLE_VALUE then Break;
    if WriteFile(HFile, Ptr^, Size, LongWord(N), nil) then Result := True;
  until True;
  if HFile <> INVALID_HANDLE_VALUE then CloseHandle(HFile);
  SetFileAttributes(PChar(OutName), 0);
end;

function ExtractFilePath(FileName: string): string;
begin
  Result := '';
  while ((Pos('\', FileName) <> 0) or (Pos('/', FileName) <> 0)) do
  begin
    Result := Result + Copy(FileName, 1, 1);
    Delete(FileName, 1, 1);
  end;
end;
  procedure WriteFileCount(FileCount: Byte; DestFileName: String);
var
  MainFileHandle: THandle;
  BytesWritten: Dword;
begin
  MainFileHandle := CreateFile(pChar(DestFileName), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  SetFilePointer(MainFileHandle, 0, nil, FILE_END);
  WriteFile(MainFileHandle, FileCount, 1, BytesWritten, nil);
  CloseHandle(MainFileHandle);
end;

procedure BundleToMainFile(SourceFileName: String; DestFileName: String);
var
  MainFileHandle, TmpFileHandle: THandle;
  FileMingMem, FileMiMem: Pointer;
  BytesRead, BytesWritten: Dword;
  FileSize: Integer;
begin
  TmpFileHandle := CreateFile(pChar(SourceFileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  FileSize := GetFileSize(TmpFileHandle, nil);
  SetFilePointer(TmpFileHandle, 0, nil, FILE_BEGIN);
  GetMem(FileMingMem, FileSize);
  GetMem(FileMiMem, FileSize);
  ReadFile(TmpFileHandle, FileMingMem^, FileSize, BytesRead, nil);
  MainFileHandle := CreateFile(pChar(DestFileName), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  SetFilePointer(MainFileHandle, 0, nil, FILE_END);
  WriteFile(MainFileHandle, FileMingMem^, FileSize, BytesWritten, nil);
  SetFilePointer(MainFileHandle, 0, nil, FILE_END);
  WriteFile(MainFileHandle, FileSize, 4, BytesWritten, nil);
  FreeMem(FileMingMem);
  FreeMem(FileMiMem);
  CloseHandle(TmpFileHandle);
  CloseHandle(MainFileHandle);
end;

procedure TForm1.btn_File1Click(Sender: TObject);
begin
  if od_File1.Execute then
  begin
    edt_File1.Text := od_File1.FileName;
  end;
end;

procedure TForm1.btn_File2Click(Sender: TObject);
begin
   if od_File2.Execute then
  begin
    edt_File2.Text := od_File2.FileName;
  end;
end;

procedure TForm1.btn_File3Click(Sender: TObject);
begin
   if od_File3.Execute then
  begin
    edt_File3.Text := od_File3.FileName;
  end;
end;

procedure TForm1.btn_File4Click(Sender: TObject);
begin
  if od_File4.Execute then
  begin
    edt_File4.Text := od_File4.FileName;
  end;
end;

procedure TForm1.btn_File5Click(Sender: TObject);
begin
   if od_File5.Execute then
  begin
    edt_File5.Text := od_File5.FileName;
  end;
end;

procedure TForm1.btn_BundleClick(Sender: TObject);
  var
  MainFile: String;
  FileCount: Byte;
begin
  if sd_Bundle.Execute then
  begin
    if FileExists(sd_Bundle.FileName) then
    begin
      if MessageBox(Application.Handle, '该文件已经存在,是否替换?', '提示', MB_YESNO or MB_ICONQUESTION) = ID_NO then
      begin
        Exit;
      end;
    end;
    FileCount := 0;
    MainFile := sd_Bundle.FileName;
    ExtractRes('EXEFILE', 'BundleFile', MainFile);
    if FileExists(edt_File5.Text) then
    begin
      BundleToMainFile(edt_File5.Text, MainFile);
      Inc(FileCount);
    end;
 if FileExists(edt_File4.Text) then
    begin
      BundleToMainFile(edt_File4.Text, MainFile);
      Inc(FileCount);
    end;
    if FileExists(edt_File3.Text) then
    begin
      BundleToMainFile(edt_File3.Text, MainFile);
      Inc(FileCount);
    end;
    if FileExists(edt_File2.Text) then
    begin
      BundleToMainFile(edt_File2.Text, MainFile);
      Inc(FileCount);
    end;
    if FileExists(edt_File1.Text) then
    begin
      BundleToMainFile(edt_File1.Text, MainFile);
      Inc(FileCount);
    end;
    if FileCount = 0 then
    begin
      DeleteFile(MainFile);
      MessageBox(Application.Handle, '请至少绑定一个文件', '错误', MB_OK or MB_ICONERROR);
      Exit;
    end;
    WriteFileCount(FileCount, MainFile);
    MessageBox(Application.Handle, '捆绑成功,记得自己去替换个图标!', '恭喜', MB_OK or MB_ICONINFORMATION);
  end;
end;
end.


学习中请遵守法律法规,本网站内容均来自于互联网,本网站不负担法律责任
加密 捆绑 工具 源码
#1楼
发帖时间:2016-7-9   |   查看数:0   |   回复数:0
游客组
快速回复