⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.~pas

📁 DELPHI与ACTIVESYNC(判断移动设备连接状态)
💻 ~PAS
字号:
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;
    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;
      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.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -