inipublicfun.pas

Barcode And LabelPrint

  Res := TestSecuData(ZKEh, ID, CreateWord(GetTickCount + 150));
  if res = 0 then
    //iniform.Memo1.Lines.Add('设置安全码成功!')
    addinfo('设置安全码成功!', clgreen)
  else if res = -1 then
    //iniform.Memo1.Lines.Add('设置安全码失败！')
    AddInfo('设置安全码失败！', clred)
  else if (res = -2) or (res = -3) then
    //iniform.Memo1.Lines.Add('该机器不能设置安全码或安全码已经存在。')
    AddInfo('该机器不能设置安全码或安全码已经存在！', clred)
  else
    //IniForm.Memo1.Lines.Add('设置安全码错误' + inttostr(res));
    AddInfo('设置安全码错误' + inttostr(res), clred);
  if (res = 0) or (res = -2) or (res = -3) then
    Result := true;
end;

function ClearDevData(ZKEH: THandle): bool;
var
  ACMD: word;

begin
  result := false;
  Acmd := CMD_CLEAR_DATA;
  ZEMBPRO_SENDCMD(ZKEH, Acmd, nil, 0, 0, 4000);
  if Acmd = CMD_ACK_OK then Result := true;
end;

function AGetBlobA(Table: TDataSet; const FieldName: string): string;
var
  ms: tmemorystream;
begin
  ms := tmemorystream.Create;
  try
    with Table.FieldByName(FieldName) as TBlobField do
    begin
      SaveToStream(ms);
      ms.Position := 0;
      SetLength(Result, ms.Size);
      ms.read(Result[1], Length(Result));
    end;
  finally
    ms.Free;
  end;
end;

function SetBlob(Table: TDataSet; const FieldName, Template: string): Boolean;
var
  ms: tmemorystream;
begin
  ms := tmemorystream.Create;
  try
    with Table.FieldByName(FieldName) as TBlobField do
    begin
      ms.SetSize(0);
      ms.write(Template[1], Length(Template));
      ms.Position := 0;
      LoadFromStream(ms);
    end;
  finally
    ms.Free;
    result := true;
  end;
end;

function ByteToHex(b: BYTE): string;
begin
  setlength(result, 2);
  result[1] := HexChar[b div 16];
  result[2] := HexChar[b mod 16];
end;

//get distinct itmes  henry modify add this function 2006-7-27
//add combox as a list item

function GetDisTValueToCMB(ATable: string; AFeild: string): TStrings;
var
  test: string;
begin
  Result := TStringList.Create;
//  With TAdoQuery.Create(nil) do
  with TAdoQuery.Create(nil) do
  begin
    try
      connection := DM.ADOCnn;
      Sql.Clear;
      test := 'SELECT distinct ' + AFeild + ' FROM  ' + ATable + '';
      sql.Text := test;
      open;
      if not Isempty then
      begin
        while not eof do
        begin
          Result.Add(fieldbyname(AFeild).AsString);
          next;
        end;
      end;
    finally
      Free;
    end;
  end;
end;

//get one vlue to a string;

function GetValueTostr(ATable: string; AFile: string; AFlagField: string; Avalue: string): string;
var
  test: string;
begin
//  With TAdoQuery.Create(nil) do
  result := '';
  with TAdoQuery.Create(nil) do
  begin
    try
      connection := DM.ADOCnn;
      Sql.Clear;
      if Avalue = 'All' then
      begin
        test := 'SELECT ' + AFile + ' FROM  ' + ATable + '';
      end
      else
      begin
        test := 'SELECT ' + AFile + ' FROM  ' + ATable + '  where ' + AFlagField + '='#39 + Avalue + #39'';
      end;
      sql.Text := test;
      open;
      if not Isempty then
      begin
        result := fieldbyname(AFile).AsString;
      end
      else
      begin
        result := '';
      end;
    finally
      Free;
    end;
  end;
end;

function ExeUpdateValue(AtableNmae: string; DevField: string; DevValue: string; LimitField: string; LimitValue: string): bool;
var
  ATempSQLStr: string;
begin
  AtempSQLStr := 'update ' + AtableNmae + ' set ' + DevField + ' = ' + #39 + DevValue + #39 + ' where '
    + limitField + ' = ' + #39 + LimitValue + #39 + '';
  //result:=false;
  with tadoquery.Create(nil) do
  begin
    try
      connection := dm.ADOCnn;
      SQL.Clear;
      SQL.Add(AtempSQLStr);
      ExecSQL;
      result := true;
    finally
      free;
    end;
  end;
end;



function GetATimeValueTostr(ATable: string; AFile: string; AFlagField: string; Avalue: string): TDateTime;
var
  test: string;
begin
//  With TAdoQuery.Create(nil) do
  with TAdoQuery.Create(nil) do
  begin
    try
      connection := DM.ADOCnn;
      Sql.Clear;
      if Avalue = 'All' then
      begin
        test := 'SELECT * FROM  ' + ATable + '';
      end
      else
      begin
        test := 'SELECT ' + AFile + ' FROM  ' + ATable + '  where ' + AFlagField + '='#39 + Avalue + #39'';
      end;
      sql.Text := test;
      open;
      if not Isempty then
      begin
        result := fieldbyname(AFile).AsDateTime;
      end
      else
      begin
        result := strtodatetime('1900-00-00');
      end;
    finally
      Free;
    end;
  end;
end;

//界面背景颜色闪烁

function flashBack(Aobject: TMemo; flashtime: integer): bool;
var
  MineObj: Tmemo;
  i: integer;
begin
  result := true;
  MineObj := Aobject;
//  MineObj.Color:=clWindow;
  MineObj.Color := clred;
  MineObj.Refresh;
  application.ProcessMessages;
  for i := 0 to flashtime do
  begin
    if (i div 2) = 0 then
    begin
      MineObj.font.color := clWindow;
      MineObj.Refresh;
      application.ProcessMessages;
      sleep(100);
    end
    else
    begin
      MineObj.font.Color := clred;
      MineObj.Refresh;
      application.ProcessMessages;
      sleep(100);
    end;
  end;
  MineObj.Refresh;
  application.ProcessMessages;
end;

procedure flashMineForm(AForm: Tform);
var
  i: integer;
begin
  for i := 0 to 15 do
  begin
    flashwindow(Aform.Handle, true);
{ 烁显示指定窗口。这意味着窗口的标题和说明文字会发生变化，似乎从活动切换到非活动状态、
    或反向切换。通常对不活动的窗口应用这个函数，引起用户的注意
返回值
Long，如窗口在调用前处于活动状态，则返回TRUE（非零）
参数表
参数 	类型及说明
hwnd 	Long，要闪烁显示的窗口的句柄
bInvert 	Long，TRUE（非零）表示切换窗口标题；FALSE返回最初状态
注解

该函数通常与一个计数器组合使用，生成连续的闪烁效果。在windows nt及windows for workgroup中，bInvert参数会被忽略。但在windows 95中不会忽略 }
    sleep(50);
  end;
end;

function SaveAStreamToDataTable(const AStream: TmemoryStream; ADOTable1: TDataSet; FiledName: string): bool;
begin
  ADOTable1.edit;
  try
    with ADOTable1.FieldByName(FiledName) as TBlobField do
    begin
      Astream.Position := 0;
      LoadFromStream(Astream);
    end;
  finally
    //ADOTable1.post;
    AStream.Position := 0;
    //AStream.ReadBuffer(result,Astream.Size-1);
    AStream.Free;
    result := true;
  end;
end;

function getDevfirmwareVer(ZKEH: THandle): string;
var
  VerBuffer: array[0..256] of Byte;
  VerCMD, i: word;

begin
  result := '';
  VerCMD := CMD_GET_VERSION;
  ZEMBPRO_SENDCMD(ZKEH, VerCMD, @VerBuffer[0], SizeOf(VerBuffer), 0, 4000);
  if VerCMD = CMD_ACK_OK then
    for i := 0 to 255 do
    begin
      result := result + char(VerBuffer[i]);
    end;
  //result := strpas(@VerBuffer)

end;

function TarCreateTGZ(Handle: HWnd; EXEPath: string; CMDStr: string): bool;
begin
  //shellexecute(Handle, 'OPEN',pansichar(EXEPath), pansichar(CMDStr), nil, 0);
  WinExec(pansichar('Command.com /C cd ' + EXEPath), SW_Hide);
  shellexecute(Handle, 'OPEN', 'tar.exe', pansichar(CMDStr), nil, 0);
  result := true;
end;

//判断文件是否存在，然后覆盖存储，成功返回1

function copyTheFile(scr: string; dec: string): integer;
begin
  if fileexists(scr) then
  begin
    copyfile(pchar(scr), pchar(dec), false);
    result := 1;
  end
  else
  begin
    result := 0;
  end;
end;

//删除备份到根目录下的文件。DeleteFile

function delTheFile(scr: string): integer;
begin
  if fileexists(scr) then
  begin
    DeleteFile(pansichar(scr));
    result := 1;
  end
  else
  begin
    result := 0;
  end;
end;

//生成bat文件

function createABATFile(AFilePath: string; FileListStr: Tstrings): bool;
var
  Astream: Tmemorystream;
  AStrList: Tstrings;
  Astring: string;
  i: integer;

begin
  Astream := Tmemorystream.Create;
  AStrList := Tstringlist.Create;
  AstrList.Add('cd ' + AFilePath);
  Astring := 'tar -cksf ' + LanguageName;
  for i := 0 to FileListStr.Count - 1 do
  begin
    Astring := Astring + ' ' + FileListStr.Strings[i];
  end;
  AstrList.Add(Astring);
  AstrList.SaveToStream(Astream);
  Astream.SaveToFile(AFilePath + 'createPack.bat');
  Astream.Free;
  AstrList.Free;
  result := true;
end;

//取得某一符号后面的值

function GetACharAfterStr(Astring: string; AChar: string): string;
var
  i: integer;
begin
  Result := '';
  i := pos(AChar, Astring);
  if i > 0 then
  begin
    result := copy(Astring, i + 1, length(Astring) - i);
  end;
end;

function KillTask(ExeFileName: string): Integer;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 //CreateToolhelp32Snapshot函数为指定的进程、进程使用的堆[HEAP]、模块[MODULE]、线程[THREAD]）建立一个快照[snapshot]。参数：
{dwFlags
[输入]指定快照中包含的系统内容，这个参数能够使用下列数值（变量）中的一个。

     TH32CS_INHERIT - 声明快照句柄是可继承的。
     TH32CS_SNAPALL - 在快照中包含系统中所有的进程和线程。
     TH32CS_SNAPHEAPLIST - 在快照中包含在th32ProcessID中指定的进程的所有的堆。
     TH32CS_SNAPMODULE - 在快照中包含在th32ProcessID中指定的进程的所有的模块。
     TH32CS_SNAPPROCESS - 在快照中包含系统中所有的进程。
     TH32CS_SNAPTHREAD - 在快照中包含系统中所有的线程。

th32ProcessID
[输入]指定将要快照的进程ID。如果该参数为0表示快照当前进程。该参数只有在设置了TH32CS_SNAPHEAPLIST或TH32CS_SNAPMOUDLE后才有效，在其他情况下该参数被忽略，所有的进程都会被快照。

返回值：
调用成功，返回快照的句柄，调用失败，返回INVAID_HANDLE_VALUE。

备注：
使用GetLastError函数查找该函数产生的错误状态码。
要删除快照，使用CloseHandle函数

进程句柄和进程ID是两回事，这时你可能很郁闷:怎么知道进程ID呢?方法当然有啦!在Windows9X/2000/XP/2003中，
微软均提供了用来枚举进程的ToolHelp API系列函数。先运用函数CreateToolhelp32Snapshot()取得快照句柄，
然后使用Process32First()以及Process32Next()枚举当前的进程。}
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32); //见开发人员指南p456
 //get the thread's ID.
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
      Result := Integer(TerminateProcess(
        OpenProcess(PROCESS_TERMINATE,
        BOOL(0),
        FProcessEntry32.th32ProcessID),
        0));
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

//返回下一个ID取最大值

function GetNextRecNoMax(ADOConnection: TADOConnection; TableName, Fieldstr, Condition, DesFieldstr: string; FieldLen: integer): longint;
var
  lMax: Integer;
  lDef: string;

begin
  lDef := '000000000000000';
  SetLength(lDef, FieldLen - 1);
  with TadoQuery.Create(nil) do
  try //---- 自动加入编号

    begin
      Connection := ADOConnection;
      SQL.Clear;
      SQL.Add('Select max(' + Fieldstr + ') as maxCount from ' + TableName);
      Open; //first

      if not Eof then //if0 如果此时已到末记录，证明Query1为空
      begin
        lMax := FieldByName('maxCount').AsInteger;
      end
      else
        lMax := 0; //end_if0  end_else0，已到末记录（Query1为空）直接增一

      Close;
    end; //end_with
    Result := lMax + 1; //最小为1
  finally
    Free;
  end;
end;
//---------------------------------------------------------
//返回下一个ID取最大值string

function GetNextRecNo(ADOConnection: TADOConnection; TableName, Fieldstr, Condition, DesFieldstr: string; FieldLen: integer): string;
var
  lMax, I: Integer;
  lID, lDef: string;
  Query1: TADOQuery;
begin
  lDef := '000000000000000'; //
  SetLength(lDef, FieldLen - 1);
  Query1 := TadoQuery.Create(nil);
  try
//---- 自动加入编号
    with Query1 do begin
      Connection := ADOConnection; //DbaseName;
      SQL.Clear;
      if Condition <> '' then