inipublicfun.pas

Barcode And LabelPrint

  AFiled.FieldAddress(Name);
  AFiled.DataSet := ADOTable1;
  result := ADOtable1.CreateBlobStream(AFiled, bmRead);
end;
//将blob读到tstream

function GetBlobToStream(Table: TDataSet; const FieldName: string; var ResultStream: TmemoryStream): Bool;
begin
  result := false;
  try
    with Table.FieldByName(FieldName) as TBlobField do
    begin
      SaveToStream(ResultStream); //把 tempmemorystream的数据写入 Memorystream当前位置 SaveToStream将自动移动指针等于append
      if ResultStream.Size > 0 then
        result := true;
    end;
  finally
    //ms.Free;
  end;
end;

//connect with database

function connect_DB(ADO: TADOConnection; ConnStr: string): bool;
begin
  try
    if ADO.Connected then
    begin
      ADO.Close;
    end;
    ADO.ConnectionString := ConnStr;
    ADO.Open;
    result := true;
  except
    begin
      MessageDlg('connect database fail,please check and set again,thanks!', mtWarning, [mbYes], 0);
      result := false;
    //exit;
    end;
  end;
end;
//connmect with database

//select database

function selectDB(Aform: TForm): string;
var
  DBLinkStr: string;
begin
  DBLinkStr := PromptDataSource(Aform.Handle, dblinkstr); //显示ado设置
  result := DBLinkStr;
end;
//select database

//read ini file

function GetCfgValue(const key: string; cfgFileName: string): string;
var
  cfn: string;
  ini: tinifile;
begin
  Result := '';
  cfn := ExtractFilePath(Application.ExeName) + cfgFileName;
  if FileExists(cfn) then
  begin
    ini := tinifile.Create(cfn);
    try
      Result := ini.ReadString('Options', key, Result);
    finally
      ini.Free;
    end;
  end;
end;
//read ini file

//write ini file

function SetCfgValue(const key: string; Value: string; cfgFileName: string): bool;
var
  cfn: string;
  ini: tinifile;
begin
  result := true;
  cfn := ExtractFilePath(Application.ExeName) + cfgFileName;
  if FileExists(cfn) then
  begin
    ini := tinifile.Create(cfn);
    try
      ini.WriteString('Options', key, value);
    finally
      ini.Free;
    end;
  end;
end;
//write ini file

//center form

function FormCenter(AForm: TForm): bool;
begin
  AForm.Top := (screen.Height - AForm.Height) div 2;
  AForm.Left := (screen.Width - AForm.Width) div 2;
  result := true;
end;
//center form

//check the valu if exits in a table. exit =true ,else =false

function checkValue(ATable: string; AFile: string; Avalue: string): bool;
var
  test: string;
begin
//  With TAdoQuery.Create(nil) do
  with TAdoQuery.Create(nil) do
  begin
    try
      connection := DM.ADOCnn;
      Sql.Clear;
    //henry2007321
    //test:='SELECT * FROM  '+ATable+'  where '+AFile+'='#39 + Avalue +#39'';
      test := 'SELECT ' + AFile + ' FROM  ' + ATable + '  where ' + AFile + '='#39 + Avalue + #39'';
      sql.Text := test;
      open;
      if not Isempty then
      begin
        result := true;
      end
      else
        result := false;
    finally
      Free;
    end;
  end;
end;
//check values

//add combox as a list item

function GetValueToCMB(ATable: string; AFile: string; Avalue: 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;
      if Avalue = 'All' then
      begin
      //test:='SELECT * FROM  '+ATable+'';
      //henry modify 2007-2-7 15:04
        test := 'SELECT  ' + AFile + '  FROM ' + ATable + '';
      end
      else
      begin
      //test:='SELECT * FROM  '+ATable+'  where '+AFile+'='#39 + Avalue +#39'';
      //henry modify 2007-2-7 15:04
        test := 'SELECT  ' + AFile + '  FROM  ' + ATable + '  where ' + AFile + '='#39 + Avalue + #39'';
      end;
      sql.Text := test;
      open;
      if not Isempty then
      begin
        while not eof do
        begin
          Result.Add(fieldbyname(AFile).AsString);
          next;
        end;
      end;
    finally
      close;
      Free;
    end;
  end;
end;

//add combox as a list item

//getlocal name.

function GetLocalName: string;
var
  CNameBuffer: PChar;
  fl_loaded: Boolean;
  CLen: ^DWord;
begin
  GetMem(CNameBuffer, 255);
  New(CLen);
  CLen^ := 255;
  fl_loaded := GetComputerName(CNameBuffer, CLen^);
  if fl_loaded then
    GetLocalName := StrPas(CNameBuffer)
  else
    GetLocalName := 'Null';
  FreeMem(CNameBuffer, 255);
  Dispose(CLen);
end;
//getlocal name.

//get server MAC

function GetMacAddress(const AServerName: string): string;
type
  TNetTransportEnum = function(pszServer: PWideChar;
    Level: DWORD;
    var pbBuffer: pointer;
    PrefMaxLen: LongInt;
    var EntriesRead: DWORD;
    var TotalEntries: DWORD;
    var ResumeHandle: DWORD): DWORD; stdcall;

  TNetApiBufferFree = function(Buffer: pointer): DWORD; stdcall;

  PTransportInfo = ^TTransportInfo;
  TTransportInfo = record
    quality_of_service: DWORD;
    number_of_vcs: DWORD;
    transport_name: PWChar;
    transport_address: PWChar;
    wan_ish: boolean;
  end;

var E, ResumeHandle,
  EntriesRead,
    TotalEntries: DWORD;
  FLibHandle: THandle;
  sMachineName,
    sMacAddr,
    Retvar: string;
  pBuffer: pointer;
  pInfo: PTransportInfo;
  FNetTransportEnum: TNetTransportEnum;
  FNetApiBufferFree: TNetApiBufferFree;
  pszServer: array[0..128] of WideChar;
  i, ii, iIdx: integer;
begin
  sMachineName := trim(AServerName);
  Retvar := '00-00-00-00-00-00';

// Add leading \\ if missing
  if (sMachineName <> '') and (length(sMachineName) >= 2) then begin
    if copy(sMachineName, 1, 2) <> '\\' then
      sMachineName := '\\' + sMachineName
  end;

// Setup and load from DLL
  pBuffer := nil;
  ResumeHandle := 0;
  FLibHandle := LoadLibrary('NETAPI32.DLL');

// Execute the external function
  if FLibHandle <> 0 then begin
    @FNetTransportEnum := GetProcAddress(FLibHandle, 'NetWkstaTransportEnum');
    @FNetApiBufferFree := GetProcAddress(FLibHandle, 'NetApiBufferFree');
    E := FNetTransportEnum(StringToWideChar(sMachineName, pszServer, 129), 0,
      pBuffer, -1, EntriesRead, TotalEntries, Resumehandle);

    if E = 0 then begin
      pInfo := pBuffer;

// Enumerate all protocols - look for TCPIP
      for i := 1 to EntriesRead do begin
        if pos('TCPIP', UpperCase(pInfo^.transport_name)) <> 0 then begin
// Got It - now format result ''xx-xx-xx-xx-xx-xx''
          iIdx := 1;
          sMacAddr := pInfo^.transport_address;

          for ii := 1 to 12 do begin
            Retvar[iIdx] := sMacAddr[ii];
            inc(iIdx);
            if iIdx in [3, 6, 9, 12, 15] then inc(iIdx);
          end;
        end;

        inc(pInfo);
      end;
      if pBuffer <> nil then FNetApiBufferFree(pBuffer);
    end;

    try
      FreeLibrary(FLibHandle);
    except
// 错误处理
    end;
  end;
  result := Retvar;
end;

//according condition get all data

function GetValueToListstr(ATable: string; AFile: string; AFlagField: string; Avalue: 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;
      if Avalue = 'All' then
      begin
      //henry modify 2007-2-7 15:04
      //test:='SELECT * FROM  '+ATable+'';
        test := 'SELECT ' + AFile + ' FROM  ' + ATable + '';
      end
      else
      begin
        if pos('and', Avalue) > 0 then test := 'SELECT ' + AFile + ' FROM  ' + ATable + '  where ' + AFlagField + '=' + Avalue + '' //表示选择
        else test := 'SELECT ' + AFile + ' FROM  ' + ATable + '  where ' + AFlagField + '='#39 + Avalue + #39'';
      end;
      sql.Text := test;
      open;
      if not Isempty then
      begin
        while not eof do
        begin
          if fieldbyname(AFile).AsString <> '' then
            Result.Add(trim(fieldbyname(AFile).AsString));
          next;
        end;
      end;
    finally
      close;
      Free;
    end;
  end;
end;
//check a string if exists in a list string. return true or false.

function CheckListWithValue(AListStrs: TStrings; AValue: string): integer;
var
  i: integer;
begin
  Result := -1;
  for i := 0 to AListStrs.Count - 1 do
  begin
    if AlistStrs.Strings[i] = AValue then
    begin
      result := i;
      break;
    end;
  end;
end;

//set options

function SetOptions(index: integer; ZKEH: THandle; sAllOpts: Tstrings): integer;
var
  i: integer;

  MemoOptions: TMemo;
  sOpts: Tstrings;
begin
  sOpts := TStringList.Create;
  try
    sOpts.Assign(sAllOpts);
    result := Sopts.Count;
{$IFDEF DEBUG}
    CodeSiteObject.Send('result := Sopts.Count' + inttostr(result), Index);
    CodeSiteObject.Send('allOpts.Count', allOpts.Count);

{$ENDIF}
    IsOptionEncrypt := ((OS = '') or (OS = 'NONE')); //无操作系统

    for i := 0 to sOpts.Count - 1 do
    begin //每项配置分别保存
    //application.ProcessMessages;
{$IFDEF DEBUG}
      CodeSiteObject.Send('正在设置' + sOpts.Strings[i], Index);
{$ENDIF}
      if not SaveOption(ZKEH, sOpts.Strings[i], IsOptionEncrypt) then
      begin
        if not SaveOption(ZKEH, sOpts.Strings[i], IsOptionEncrypt) then
          result := result - 1;
        addinfoini(2, Index, '----设置配置' + sOpts.Strings[i] + '失败', clred); // div 1000

      end;
      sleep(100);
    end;
  finally
    sOpts.Free;
  end;
end;
//设置时间
//取得系统时间,然后设置.

function SetDevTime(ZKEH: THandle; TimeFlag: integer): integer;
var
  ATime: Tdatetime;
  test: string;
  ACMD: word;

begin
  //TimeINI:='';
//select getdate() as d
  Atime := Date + now; //当前Pc时间
  with TAdoQuery.Create(nil) do
  begin
    try
      connection := DM.ADOCnn;
      Sql.Clear;
      test := 'select getdate() as DD'; //获得服务器时间
      sql.Add(test);
      open;
      if not Isempty then
      begin
        ATime := fieldbyname('dd').AsDateTime;
        TimeINI := ATime;
      end;
    finally
      Free;
    end;
  end;
  if TimeFlag = 0 then
  begin
    result := EncodeZKTime(ATime);
  end;
  if TimeFlag = 1 then
    //result:=EncodeZKTime(ATime-13/24); //美国东部时间
    result := EncodeZKTime(ATime - 13 / 24);
  TimeIni := DecodeZKTime(result);
  ACMD := CMD_SET_TIME; //CMD_GET_TIME = 201 获得时间
  ZEMBPRO_SENDCMD(ZKEH, ACMD, pchar(@result), 8, 8, 2000);
end;
{function GetDevTime(ZKEH: THandle; TimeFlag: integer): integer;
var
  ATime: Tdatetime;
  test: string;
  ACMD: word;

begin
  //TimeINI:='';
//select getdate() as d
  Atime := Date + now; //当前Pc时间

  if TimeFlag = 0 then
  begin
    result := EncodeZKTime(ATime);
  end;
  if TimeFlag = 1 then result := EncodeZKTime(ATime - 13 / 24);    //result:=EncodeZKTime(ATime-13/24); //美国东部时间

  TimeIni := DecodeZKTime(result);
  ACMD := CMD_GET_TIME;  // = 201 获得时间
  ZEMBPRO_SENDCMD(ZKEH, ACMD, pchar(@result), 8, 8, 2000);
end; }

//设置安全码

function UpdateFlashSecurityKey(ZKEH: THandle; c: integer): boolean;
begin
  Result := True;
  cmd := CMD_GET_FLASHID;
  ZEMBPRO_SENDCMD(ZKEH, cmd, @c, SizeOf(c), 0, 4000);
  if (cmd = CMD_ACK_OK) and (c = $88C2) then
  begin
    if not UpdateSecurityKey(ZKEH, c) then
      Result := False;
  end;
end;

function UpdateSecurityKey(ZKEH: THandle; ID: Word): bool;
var
  Res: integer;

begin
  result := false;