- unit Unit1;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, RzButton, StdCtrls, AutoSink, RzStatus, ExtCtrls, RzPanel,
- ImgList;
- type
- TRapiInit = record
- cbSize:DWORD;
- heRapiInit:THandle;
- hrRapiInit:HResult;
- end;
- TForm1 = class(TForm)
- RzBitBtn1: TRzBitBtn;
- Label1: TLabel;
- RzStatusBar1: TRzStatusBar;
- GlyphStatus: TRzGlyphStatus;
- ImageList1: TImageList;
- Label2: TLabel;
- procedure RzBitBtn1Click(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- private
- { Private declarations }
- public
- procedure CreateParams(var Params: TCreateParams);override;
- procedure ChangeActif(Sender: TObject);
- { Public declarations }
- end;
- var
- Form1: TForm1;
- DccMan: TDccMan;
- function copyFileFromDevice(LocalFile: string; RemoteFile: string):bool;
- function CeRapiInit():integer; stdcall; external 'RAPI.DLL';
- function CeRapiUninit():integer; stdcall; external 'RAPI.DLL';
- function CeDeleteFile(local: WideString): Boolean;stdcall;external 'RAPI.DLL';
- function CeRapiInitEx(var rapiinit: TRapiInit):Integer;stdcall;external 'RAPI.DLL';
- function CeCreateFile(lpFileName: WideString; dwDesiredAccess: cardinal; dwShareMode: cardinal; lpSecurityAttributes: pSecurityAttributes; dwCreationDisposition: cardinal; dwFlagsAndAttributes: cardinal; hTemplateFile: cardinal):cardinal; stdcall;external 'RAPI.DLL';
- function CeReadFile(hFile: cardinal;var lpBuffer; nNumberOfBytesToRead: cardinal; var lpNumberOfBytesRead: cardinal; lpOverlapped: poverlapped):bool; stdcall; external 'RAPI.DLL';
- function CeWriteFile(hFile: cardinal;const lpBuffer; nNumberOfBytesToWrite: cardinal; var lpNumberOfBytesWritten: cardinal; lpOverlapped: poverlapped):bool; stdcall; external 'RAPI.DLL';
- function CeCloseHandle(IntPtr: thandle):integer; stdcall; external 'RAPI.DLL';
- implementation
- {$R *.dfm}
- function VoirSiConnect(attente : integer) : boolean;
- var
- ri: TRapiInit;
- hRes: HRESULT;
- dwRet: HRESULT;
- begin
- ri.cbSize := sizeof(ri);
- hRes := CeRapiInitEx(ri);
- if hRes = S_OK then
- begin
- dwRet := WaitForSingleObject(ri.heRapiInit, attente);
- if ((dwRet <> WAIT_OBJECT_0) OR (ri.hrRapiInit <> S_OK))then
- begin
- CeRapiUninit;
- Result := false;
- end
- else
- begin
- Result := true;
- end;
- end
- else
- begin
- Result := false;
- end;
- end;
- procedure CloreConnection;
- begin
- CeRapiUninit;
- end;
- procedure TForm1.ChangeActif(Sender: TObject);
- var
- LogEtat : string;
- SActifIPAS, STermineAS, SActifAS, SInactifAS, SReponseAS: string;
- SListenAS, SDeconnexionAS, SErreur,SDeconnectAS: string;
- Connect: Boolean;
- i: integer;
- begin
- SActifIPAS := '设备已连接';
- STermineAS := '设备关闭';
- SActifAS := '设备活动中';
- SInactifAS := '非连接状态';
- SReponseAS := '响映中...';
- SListenAS := '连接中...';
- SDeconnexionAS := '连接断开';
- SErreur := '连接错误';
- SDeconnectAS := '关闭连接';
- Connect := False;
- case DccMan.IndexOnLog of
- 1 :
- begin
- LogEtat := SActifIPAS;
- if copyFileFromDevice('e:/mp3.txt','mp3.txt') then
- Label2.Caption := '文件复制完成!';
- GlyphStatus.ImageIndex := 1;
- end;
- 2 : LogEtat := STermineAS;
- 3 : LogEtat := SActifAS;
- 4 : LogEtat := SInactifAS;
- 5 :
- begin
- LogEtat := SReponseAS;
- end;
- 6 :
- begin
- LogEtat := SListenAS;
- //GlyphStatus.ImageIndex := 2;
- end;
- 7 :
- begin
- LogEtat := SDeconnexionAS;
- GlyphStatus.ImageIndex := 2;
- end;
- 8 :
- begin
- LogEtat := SErreur;
- GlyphStatus.ImageIndex := 3;
- end;
- end;
- Label1.Caption := LogEtat;
- GlyphStatus.Caption := LogEtat;
- if (DccMan.IndexOnLog=6) or (DccMan.IndexOnLog=5) then
- begin
- for i:=9 to 23 do
- GlyphStatus.ImageIndex := i;
- end;
- if not Connect and (DccMan.IndexOnLog = 1) then
- begin
- Connect := VoirSiConnect(5000);
- end;
- if Connect and (DccMan.IndexOnLog <> 1) then
- begin
- Connect := false;
- CloreConnection;
- MessageBox(Handle, PChar(SDeconnectAS), '提示:', MB_OK or MB_ICONWARNING);
- end;
- end;
- procedure TForm1.CreateParams(var Params: TCreateParams);
- begin
- inherited;
- Params.Style := WS_SYSMENU;
- end;
- {----------从移动设备复制文件到PC机中----------}
- function copyFileFromDevice(LocalFile: string;RemoteFile: string):bool;
- var
- fs: TFileStream;
- ahandle: thandle;
- FTempBuffer: array[0..$1000] of byte;
- nwrite,nRead: dword;
- ini: integer;
- begin
- result := true;
- ini := CeRapiInit();
- if (ini<>0) then
- begin
- exit;
- end;
- ahandle := CeCreateFile(RemoteFile, $80000000, 0, 0, 3, $80, 0);
- if ahandle=-1 then
- begin
- //showmessage('在设备上创建文件失败!');
- MessageBox(0,'下载文件失败,请检查设备是否正确连接!','提示:',MB_OK OR MB_ICONWARNING);
- CeRapiUninit();
- result := false;
- exit;
- end;
- if fileexists(localfile) then
- deletefile(localfile);
- fs:=tfileStream.Create(localfile,fmCreate);
- CeReadFile(ahandle,FtempBuffer,sizeof(fTempBuffer),nRead,0);
- if nRead<=0 then
- begin
- MessageBox(0,'数据采集器中没有barcode.txt文件,无法导出!','错误提示:',MB_OK OR MB_ICONWARNING);
- fs.Free;
- CeRapiUninit();
- Exit;
- end;
- while nRead>0 do
- begin
- fs.Write(fTempBuffer,nRead);
- if not CeReadFile(ahandle,FtempBuffer,sizeof(fTempBuffer),nRead,0) then
- begin
- result:=false;
- break;
- end;
- end;
- CeCloseHandle(ahandle);
- fs.Free;
- CeRapiUninit();
- end;
- procedure TForm1.RzBitBtn1Click(Sender: TObject);
- var
- ri: TRapiInit;
- hRes: HRESULT;
- dwRet: DWORD;
- fpath, f: string;
- sa: SECURITY_ATTRIBUTES;
- Msg: string;
- begin
- Msg := '1、请检查设备是否正确连接!'+#13+'2、系统中是否安装通讯软件Microsoft ActiveSync V4.5!';
- fpath := 'C:/ShineJit/';
- f := 'barcode.txt';
- if not DirectoryExists(fpath) then
- begin
- sa.nLength := SizeOf(sa);
- sa.lpSecurityDescriptor := 0;
- sa.bInheritHandle := True;
- CreateDirectory(PChar(fpath),sa.lpSecurityDescriptor);
- end;
- ri.cbSize := sizeof(ri);
- hRes := CeRapiInitEx(ri);
- dwRet := WaitForSingleObject(ri.heRapiInit, 2000);
- if ((dwRet <> WAIT_OBJECT_0) or (SUCCEEDED(ri.hrRapiInit) = FALSE)) then
- begin
- // Could not initialize Rapi
- MessageBox(0,PChar(Msg),'导出失败:',MB_OK OR MB_ICONWARNING);
- CeRapiUninit;
- Exit;
- end;
- if copyFileFromDevice(fpath+'barcode.txt','barcode.txt') and CeDeleteFile(f) then
- MessageBox(Handle,'数据下载成功!','提示:',MB_OK OR MB_ICONINFORMATION);
- end;
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- DccMan := TDccMan.Create;
- DccMan.OnChange := ChangeActif;
- DccMan.Advise;
- end;
- end.
其中需要创建一个AutoSink单元,代码暂不提供!呵呵!!!