gvas.~pas

delphi6.0电子寻更源程序,用来计算保安有无查抄

unit Gvas;

interface
uses
  windows,Messages,Sysutils,forms,FileCtrl,IniFiles;
const
  WM_MESSAGE1 = WM_USER + 400;
  WM_MsgSave=WM_USER+401;
  Msg_Comm=1;
  Msg_Comm_InitSuccess=1;
  Msg_Comm_InitFale=2;
  Msg_Comm_DeviceErr=3;
  Msg_Comm_comerror=4;

  Msg_Pen=2;
  Msg_Pen_Detecting=1;
  Msg_Pen_present=2;
  Msg_Pen_absent=3;
  MSg_Pen_offline=4;
  Msg_Pen_DRStart=5;
  Msg_Pen_DREnd=6;
  Msg_Pen_ClearData=7;
  Msg_Pen_ClearDataSucc=8;
  Msg_Pen_SetTime=9;
  Msg_Pen_SetTimeSucc=10;
  Msg_Pen_GetTime=11;
  Msg_Pen_GetTimeSucc=12;
  Msg_Pen_SetTimeFale=13;
  msg_pen_settimeformatfale=99;//时间格式不正确
  Msg_Pen_SaveData=14;
  Msg_Pen_TestLed=15;
  Msg_Pen_TestBell=16;
  Msg_Pen_ReadTime=17;
  Msg_Pen_Testdatacnt=18;
  Msg_Pen_DatacntERR=19;
  Msg_Pen_WritePencode=20;
  Msg_Pen_WritePencodeSucc=21;
  Msg_Pen_WritePencodeFale=22;
  Msg_Pen_setpenmod=23;
  Msg_Pen_setpenmodSucc=24;
  Msg_Pen_setpenmodFale=25;
  Msg_Pen_WritePenMode=30;
  Msg_Pen_WritePenModeSucc=31;
  Msg_Pen_WritePenModeFale=32;
  Msg_Pen_InitPen=40;
  Msg_Pen_InitPenSucc=41;
  Msg_Pen_InitPenFale=42;
  Msg_PCode=3;

  Msg_pDataCount=4;

  Msg_PDataPoint=5;

  Msg_PDtTryPoint=6;

  Test_LED=1;
  Test_bell=2;
  test_time=4;
  test_DataCnt=8;
type
  Frametype=record
         add:byte;
     command:byte;
         len:byte;
        buff:array [0..8] of byte;
         crc:byte;

  end;

  PFrametype=^Frametype;

  E2buffS=array  [1..8] of byte;
  E2Buff=array  [1..5000] of e2buffs;
  pe2buff=^e2buff;
  strpointer = ^string;
function  ByteDecToHex(d1:byte):byte;
function  ByteHexToDec(d1:byte):byte;
function  IntToStrL(d1:integer;l1:integer):string;
function  legthExcludeBlank(s1:string):integer;
procedure UnzipTime(const zipbuf:array of byte ;var unzipbuf:array of byte);
function  getkeyset(var ls,ms,rs:string):integer;
function  setkeyset(const ls,ms,rs:string):integer;
function  MenuModifyEnabled:boolean;
procedure WriteLog(const sText:string);//写日至文件
VAR ComBaud:integer;    //combaud:0 2400 combaud:1 19200
implementation
procedure WriteLog(const sText:string);
var
    f1:textfile;            //文本文件
    sCurrentPath:string;
    sLogFile:string;
begin                                  //日志文件
    getdir(0,sCurrentPath);
    if not DirectoryExists(sCurrentPath+'\log') then
    begin
        try
            if not CreateDir(sCurrentPath+'\log') then
                exit;
        except
        end;
    end;

    sLogFile:=sCurrentPath+'\log\tongxin'+'.log';
    assignfile(f1,sLogFile);
    try
        if not fileexists(sLogFile) then
            rewrite(f1)         //创建新的日志文件
        else
            append(f1);         //以写的方式打开日志文件，指针在文件末尾
        writeln(f1,sText);  //写日志文件
    finally
        closefile(f1);
    end;
end;
{function Tuser.encrypt(const s: string ):string;
var
  I: byte;
  key: word;
begin
  key:=65535;
  Result:=s;
  for i:=1 to length(s)  do
  begin
//    result[i]:=char(byte(s[i]) xor (key shr 8));
    result[i]:=char(((byte(s[i])) xor (key shr 12))+39);
//    key:=(byte(result[i])+key)*c1+c2;
  end;
end;
}
function   ini:string;
var filename1,temp1:string;
inif:tinifile;
temp2:string;
begin
filename1:=ExtractFiledir(APPLICATION.EXENAME)+'\'+ExtractFilename(APPLICATION.EXENAME);//+'\hdxgxt.ini';
if not fileexists(filename1) then
filename1:=ExtractFileDir(APPLICATION.EXENAME)+'hdxgxt.ini'
else filename1:=extractfiledir(application.exename)+'\hdxgxt.ini';
inif:=TInifile.Create(filename1);
temp1:=inif.readstring('MANUINFO','SPLASHNAME',temp1);
temp2:=inif.readstring('com_baud','type',temp2);
inif.Free;
if temp1='' then
temp1:='巡更管理系統';
result:=temp1;
end;
function  ByteHexToDec(d1:byte):byte;
begin
  result:=(d1 div 16)*10+(d1 mod 16);
end;

function  ByteDecToHex(d1:byte):byte;
begin
  result:=(d1 div 10)*16+(d1 mod 10);
end;

function  IntToStrL(d1:integer;l1:integer):string;
Begin
  result:=inttostr(d1);
  while length(result)<l1 do
    result:='0'+result;
end;

function  legthExcludeBlank(s1:string):integer;
var
  i1:integer;
begin
  result:=0;
  for i1:=1 to length(s1) do
    if s1[i1]<>' ' then inc(result);

end;

procedure UnzipTime(const zipbuf:array of byte ;var unzipbuf:array of byte);
var
 b1,b2:byte;
begin

 unzipbuf[0]:=ByteHexToDec(zipbuf[0]);        //year
 b1:=zipbuf[1];
 unzipbuf[1]:=ByteHexToDec(b1 shr 3);      //month
 b1:=zipbuf[1];b2:=zipbuf[2];
 unzipbuf[2]:=ByteHexToDec(((b1 and $07) shl 3) or (b2 shr 5)); //date
 b1:=zipbuf[2];b2:=zipbuf[3];
 unzipbuf[3]:=ByteHexToDec(((b1 and $1f) shl 1) or (b2 shr 7)); //hour
 b1:=zipbuf[3];
 unzipbuf[4]:=ByteHexToDec(b1 and $7f);   //minute
end;

function  getkeyset(var ls,ms,rs:string):integer;
var
  s2:pchar;
  INIFile:string;
begin
  getmem(s2,20);
  try
  inifile:=ExtractFiledir(APPLICATION.EXENAME)+'\'+ExtractFilename(APPLICATION.EXENAME);//+'\hdxgxt.ini';
  if not fileexists(inifile) then
  inifile:=ExtractFileDir(APPLICATION.EXENAME)+'hdxgxt.ini'
  else inifile:=extractfiledir(application.exename)+'\hdxgxt.ini';
  GetPrivateProfileString('keyboard','leftkey','異常',s2,8,pchar(INIFile));
  ls:=s2;
  GetPrivateProfileString('keyboard','middlekey','正常',s2,8,pchar(INIFile));
  ms:=s2;
  GetPrivateProfileString('keyboard','rightkey','不明',s2,8,pchar(INIFile));
  rs:=s2;
    result:=1;
  finally
    freemem(s2);
  end;
end;

function  setkeyset(const ls,ms,rs:string):integer;
var
  INIFile:string;
  number1:longbool;
begin
try
  inifile:=ExtractFiledir(APPLICATION.EXENAME)+'\'+ExtractFilename(APPLICATION.EXENAME);//+'\hdxgxt.ini';
  if not fileexists(inifile) then
  inifile:=ExtractFileDir(APPLICATION.EXENAME)+'hdxgxt.ini'
  else inifile:=extractfiledir(application.exename)+'\hdxgxt.ini';
  number1:=writeprivateprofilestring('Keyboard','LeftKey',
             pchar(ls),
             pchar(INIFile));
  if number1=false then begin result:=-1;exit;end;
  number1:=writeprivateprofilestring('Keyboard','MiddleKey',
             pchar(ms),
             pchar(INIFile));
  if number1=false then begin result:=-1;exit;end;
  number1:=writeprivateprofilestring('Keyboard','RightKey',
             pchar(rs),
             pchar(INIFile));
  if number1=false then begin result:=-1;exit;end;
  result:=1;
except
 result:=0;
  end;
end;

function  MenuModifyEnabled:boolean;
var
  s2:pchar;
  ss:string;
  INIFile:string;
begin
  getmem(s2,20);
  try
 inifile:=ExtractFiledir(APPLICATION.EXENAME)+'\'+ExtractFilename(APPLICATION.EXENAME);//+'\hdxgxt.ini';
  if not fileexists(inifile) then
  inifile:=ExtractFileDir(APPLICATION.EXENAME)+'hdxgxt.ini'
  else inifile:=extractfiledir(application.exename)+'\hdxgxt.ini';
    GetPrivateProfileString('Menu','modify','0',s2,8,pchar(INIFile));
  ss:=s2;
  if strtoint(ss)=1 then result:=true
  else result:=false;
  finally
    freemem(s2);
  end;
end;
end.