inipublicfun.pas

Barcode And LabelPrint

        SQL.Add('Select Distinct ' + Fieldstr + ' from ' + TableName + ' where ' + Condition + ' Order By ' + DesFieldstr + ' Desc')
      else
        SQL.Add('Select Distinct ' + Fieldstr + ' from ' + TableName + ' Order By ' + Fieldstr + ' Desc');
      Open; //first
      if DesFieldstr = '' then DesFieldstr := Fieldstr;
      if not Eof then //if0 如果此时已到末记录，证明Query1为空
      begin
        lMax := StrToInt('0' + FieldByName(DesFieldstr).AsString);
        if RecordCount = lMax then //if1 //如果已到末记录，否则
          lID := Copy(lDef + IntToStr(RecordCount + 1), Length(lDef + IntToStr(RecordCount + 1)) - (FieldLen - 1), FieldLen)
        else //else1
        begin
          for I := RecordCount downto 0 do
          begin
            lMax := StrToInt64('0' + FieldByName(DesFieldstr).AsString);
            if I = lMax then
            begin
              lID := Copy(lDef + IntToStr(I + 1), Length(lDef + IntToStr(I + 1)) - (FieldLen - 1), FieldLen);
              Break;
            end else Next;
            if I = 0 then lID := lDef + '1';
          end; //end_for
        end; //end_else1
      end else lID := lDef + '1'; //end_if0  end_else0，已到末记录（Query1为空）直接增一
      Close;
    end; //end_with
    Result := lID;
  finally
    Query1.Free;
  end;
end;
//2006-05-26 chx add
//获取系统目录'C:\WINNT'

function myGetWindowsDirectory: string;
var
  pcWindowsDirectory: PChar;
  dwWDSize: DWORD;
  tempPosition: integer;
begin
  dwWDSize := MAX_PATH + 1;

  result := '';
  GetMem(pcWindowsDirectory, dwWDSize);
  try
    if Windows.GetWindowsDirectory(pcWindowsDirectory, dwWDSize) <> 0 then
    begin
      tempPosition := Pos(':\', pcWindowsDirectory);
      Result := copy(pcWindowsDirectory, 1, tempPosition + 1); //返回'C:/'
    end;
  finally
    FreeMem(pcWindowsDirectory);
  end;
end;
//当前所选并且checked的项

function getchklstCurrSelected(chklst: TCheckListBox): string;
var i: integer;
begin
  for i := 0 to (chklst.Items.Count - 1) do
  begin
    if (chklst.Selected[i]) then //and ()
    begin
      if chklst.Checked[i] then Result := '1' + chklst.Items.Strings[i] //表示选择
      else Result := '0' + chklst.Items.Strings[i]; //表示取消
      break;
    end;
  end;
end;

function getchklstAllChecked(chklst: TCheckListBox): TStrings;
var i: integer;
begin
  Result := TStringList.Create; //不知要不要手工释放
//  try
  for i := 0 to (chklst.Items.Count - 1) do
  begin
    if chklst.Checked[i] then
    begin
      Result.Add(chklst.Items.Strings[i]);
    end;
  end;
// finally
//  end;
end;
//压缩流为包文件 sysDiscDriver+/CreatPackZk.tgz

function AutoComp(fileNames: string; TgzFileName: string): boolean; //在系统目录下 ;OrgFileName:string
var //文件列表
  sysDiscDriver: string;
  TUGZipdir: string;
  ZKPacksdir: string;
  devfilesdir: string;
  batfile: textfile;
  batfilestr: string;
  tzsfile: textfile;
  tzsfilestr: string;
  filePackZKstr: string;
  filepackZK: textfile;
  i: integer;
begin
  Result := false;
  try
    //sysDiscDriver := myGetWindowsDirectory;
   //TUGZipdir := sysDiscDriver + 'Program Files\tugzip'; //系统需安装tugzip
    TUGZipdir := gCurrDirectory + 'tugzip'; //tugzip程序在本系统的文件夹下的tugzip子目录中
    ZKPacksdir := AnsiReplaceText(gCurrDirectory + 'ZKPack', '\', '\\'); //压缩后文件目录
              //返回字符串AText中用子串AFromText替换成子串AToText的结果
    devfilesdir := AnsiReplaceText(gCurrDirectory + 'devfiles', '\', '\\'); //工作文件目录
{$IFDEF DEBUG}
    CodeSiteObject.Send('TUGZipdir', TUGZipdir);
    CodeSiteObject.Send('ZKPacksdir', ZKPacksdir);
    CodeSiteObject.Send('devfilesdir', devfilesdir);
    CodeSiteObject.Send('TgzFileName', TgzFileName);
    CodeSiteObject.Send('fileNames', fileNames);
{$ENDIF}
   //自动创建CreatePackZK.tzs
    tzsfilestr := TUGZipdir + '\' + 'CreatePackZK.tzs'; // 脚本文件
    if FileExists(tzsfilestr) then
    begin
      FileMode := 2;
      AssignFile(tzsfile, tzsfilestr);
      Erase(tzsfile); //如果存在先删去
      Rewrite(tzsfile);
    end
    else
    begin
      FileMode := 2;
      AssignFile(tzsfile, tzsfilestr);
      Rewrite(tzsfile);
    end;
    try
      Writeln(tzsfile, 'function main()         ');
      Writeln(tzsfile, '{                       ');
      Writeln(tzsfile, 'var Comp = new Compress();');
      Writeln(tzsfile, 'Comp.Archive ="' + ZKPackSdir + '\\' + TgzFileName + '";'); //压缩包存放地点及包名
      Writeln(tzsfile, 'Comp.Type = "TGZ";                   ');
      Writeln(tzsfile, 'Comp.Compression = 3;');
      Writeln(tzsfile, 'Comp.WorkingDir = "' + devfilesdir + '\\";'); //工作目录必须存在
      Writeln(tzsfile, 'Comp.Data = "' + fileNames + '";'); //要压缩文件必须在工作目录中
      Writeln(tzsfile, 'Comp.Password = " ";');
      Writeln(tzsfile, 'Comp.DateExtension = 0;');
      Writeln(tzsfile, 'Comp.TimeExtension = 0;');
      Writeln(tzsfile, 'Comp.Overwrite = 1;');
      Writeln(tzsfile, 'Comp.Recurse = 0;');
      Writeln(tzsfile, 'Comp.StoreFolderNames = 1;');
      Writeln(tzsfile, 'Comp.IncludeHiddenFiles = 1;');
      Writeln(tzsfile, ' Comp.DoCompress();');
      Writeln(tzsfile, '}');
      Writeln(tzsfile, '');
     // {$IFDEF DEBUG}
      //CodeSiteObject.Send(tzsfilestr,tzsfile);
    //{$ENDIF}
    finally
      CloseFile(tzsfile);
    end;
    //自动创建bat文件
    batfilestr := AppPath + '\' + 'CreatePackZk.bat';
    if not FileExists(batfilestr) then
    begin
      FileMode := 2;
      AssignFile(batfile, batfilestr);
      Rewrite(batfile);
      try
        Writeln(batfile, '@echo off');
      //if UpperCase(sysDiscDriver) <> UpperCase(copy(AppPath, 1, 3)) then Writeln(batfile, copy(sysDiscDriver, 1, 2));
        Writeln(batfile, copy(AppPath, 1, 2));
        Writeln(batfile, 'cd ' + TUGZipdir);
        Writeln(batfile, 'tzscript.exe CreatePackZk.tzs'); // tzsfilestr
      //Writeln(batfile, 'echo.& pause '); //提示等待
        Writeln(batfile, 'echo. '); //自动关闭
      finally
        CloseFile(batfile);
      end;
    end;
    //先删去原同名文件
    if FileExists(gCurrDirectory + 'ZKPack' + '\' + TgzFileName) then SysUtils.DeleteFile(gCurrDirectory + 'ZKPack' + '\' + TgzFileName);
   //执行bat命令
    for i := 1 to 3 do
    begin //连续3次
      WinExec(pansichar(batfilestr), SW_Hide); //SW_SHOW SW_Hide Command.com /C cd '+ EXEPath  //SW_SHOW SW_SHOWNORMAL
      DelayTimeMs(60 * 10); //等待10秒
      if FileExists(gCurrDirectory + 'ZKPack' + '\' + TgzFileName) then
      begin
        Result := true;
        break;
      end;
    end;
  //  CloseFile(batfilestr);
  except
    Result := false;
  end;
end;
//-----分别压缩子包

function CreateZKPackChildPub(OptName, table, NameField, NameFieldValue, StreamField: string; var TempMemorystream: TmemoryStream): boolean;
var SQLStr: string;
begin
  addInfo('正在压缩' + OptName + ':' + NameFieldValue + '...', clgreen);
  result := true;
  with dm.Qtemp do
  begin
    Close;
    SQL.Clear;
    SQLStr := 'select * from ' + table;
    SQL.Add(SQLStr);
    Open;
    if NameFieldValue = '' then
    begin
      ShowMessage('' + OptName + ':' + NameFieldValue + '还没有选择!,请重新压缩!');
    end;
 //Locate('Company;Contact;Phone', VarArrayOf(['Sight Diver', 'P', '408-431-1000']), [loPartialKey]);
    if not Locate(NameField, NameFieldValue, []) then result := false; //定位
    if not GetBlobtoStream(DM.Qtemp, table, TempMemorystream) then result := false;
    if result then
    begin
      //showmessge('压缩' + OptName + ':' + NameFieldValue + '完毕!');
    end
    else
    begin
     // addInfo('压缩' + OptName + ':' + NameFieldValue + '失败!', clred);
      ShowMessage('压缩' + NameFieldValue + '不成功,请检查!');
      Abort;
    end;
  end;
end;
//延时秒

procedure DelayTime(Second: Cardinal);
var
  dwLast, dwInterval: Cardinal;
begin
  dwInterval := 1000 * Second;
  dwLast := GetTickCount;
  while True do
  begin
    Application.ProcessMessages;
    if (GetTickCount - dwLast) > dwInterval then Break;
  end;
end;
//延时毫秒

procedure DelayTimeMs(iMillisecond: Cardinal);
var
  dwLast: Cardinal;
begin
  dwLast := GetTickCount;
  while True do
  begin
    Application.ProcessMessages;
    if (GetTickCount - dwLast) > iMillisecond then Break;
  end;
end;

function getfeildValue(tableName, DfeildName, SfeildName, value: string): string;
begin
  with TAdoQuery.Create(nil) do
  begin
    try
      connection := DM.ADOCnn;
      Sql.Clear;
      sql.Add('SELECT * FROM ' + tableName); // +'where'+SfeildName+'=
      open;
      if not Isempty then
        if Locate(SfeildName, value, []) then Result := fieldbyName(DfeildName).asstring;
    finally
      Free;
    end;
  end;
end;

function getNamefromOtherOpts(tableName, DfeildName, SfeildName, devNum: string): string;
var
  sqlStr: string;
begin
  with TAdoQuery.Create(nil) do
  begin
    try
      connection := DM.ADOCnn;
      sqlStr := 'SELECT a.* FROM ' + tableName + ' a,devicetype b where a.' + SfeildName + '=b.' + SfeildName + ' and b.devnum=' + devNum;
      Sql.Clear;
      sql.text := sqlStr; // +'where'+SfeildName+'=
      open;
      if not Isempty then
        Result := fieldbyName(DfeildName).asstring;
    finally
      Free;
    end;
  end;
end;

function downLoadfiles(Table: TDataSet; const FieldName, hint: string; filePathAndNamestr: string): boolean;
var
  FileMemo: TmemoryStream;
  SaveDialogfile: TSaveDialog;
  SQLStr: string;
  fileName: string;
  filePathAndName: string;
  MB_YESNOCANCELint: Integer;
begin

  Result := false;
  FileMemo := Tmemorystream.Create;
  SaveDialogfile := TSaveDialog.Create(Application);
  try
    SaveDialogfile.InitialDir := 'C:/';

    if (GetBlobtoStream(Table, FieldName, FileMemo)) or (FileMemo.Size <> 0) then //
    begin
      if filePathAndNamestr <> '' then
        fileName := ExtractFileName(filePathAndNamestr) //从全路径中提取出文件名不是全路径也可
      else filename := '';
      if fileName <> '' then
      begin

        MB_YESNOCANCELint := Application.MessageBox(pchar('是否要选择保存路径和文件名?' + #13#13#13 + '默认路径和文件名:' + defaultFilepath + fileName), pchar('提示'), MB_YESNOCANCEL);
        if MB_YESNOCANCELint = IDYES then isSelectDownFilepath := true;
        if MB_YESNOCANCELint = IDNO then isSelectDownFilepath := false;
        if MB_YESNOCANCELint = IDCANCEL then Abort;
      end else
      begin
        isSelectDownFilepath := true;
      ///
      end;
      SaveDialogfile.FileName := defaultFilepath + fileName;
      if (isSelectDownFilepath) then
      begin
        if SaveDialogfile.Execute then
          filePathAndName := SaveDialogfile.FileName;
       //filememo.SaveToFile();
      end
      else
        filePathAndName := defaultFilepath + fileName;
      if filePathAndName <> '' then filememo.SaveToFile(filePathAndName);

      if (FileExists(filePathAndName)) and (filePathAndName <> '') then
      begin
        Result := true;
        showmessage('下载' + hint + '成功！')
      end
      else showmessage('下载' + hint + '失败！');
    end
    else
    begin
      //filememo.free;
      //DM.QBaseInfo.Close;
      showmessage('下载' + hint + '失败！或文件为空');
    end;
  finally
    filememo.free;
    SaveDialogfile.Free;
  end;
end;
//导入导出

function Imexportfiles(exOrIm: boolean; Table: TDataSet; const FieldName, hint: string): boolean; //true为ex else 为im
var
  FileMemo: TmemoryStream;
  SaveDialogfile: TSaveDialog;
  openDialogfile: TOpenDialog;
  SQLStr: string;
  fileName: string;
  filePathAndName: string;
begin

  Result := false;
  FileMemo := Tmemorystream.Create;

  try
  //导出
    if exOrIm then //如果为导出
    begin
      SaveDialogfile := TSaveDialog.Create(Application);
      try

        SaveDialogfile.InitialDir := 'C:/';
        SaveDialogfile.FileName := hint + '.txt';
        if (GetBlobtoStream(Table, FieldName, FileMemo)) or (FileMemo.Size <> 0) then //
        begin
          if SaveDialogfile.Execute then
            filePathAndName := SaveDialogfile.FileName;


          if filePathAndName <> '' then filememo.SaveToFile(filePathAndName);

          if (FileExists(filePathAndName)) and (filePathAndName <> '') then
          begin
            Result := true;
            showmessage('导出' + hint + '成功！')
          end
          else showmessage('导出' + hint + '失败！');
        end
        else
        begin
      //filememo.free;
      //DM.QBaseInfo.Close;
          showmessage('导出' + hint + '失败！或文件为空');
        end;
      finally
        SaveDialogfile.Free;
      end;
    end;
//如果为导入
    if not exOrIm then
    begin
      openDialogfile := TOpenDialog.Create(Application);
      try
        openDialogfile.InitialDir := 'C:/';
        openDialogfile.FileName := hint + '.txt';
        if openDialogfile.Execute then
          filePathAndName := openDialogfile.FileName;
        if filePathAndName <> '' then
          FileMemo.LoadFromFile(filePathAndName);

        if (FileMemo.Size > 0) then
        begin
          if blobcontenttostring(filePathAndName, Table, FieldName) then
          begin
            Result := true;
            showmessage('导入' + hint + '成功！')
          end else showmessage('导入' + hint + '失败！');
        end
        else
        begin
          showmessage('导入' + hint + '失败！或文件为空');
        end;
      finally
        openDialogfile.Free;
      end;

    end;
  finally
    filememo.free;

  end;
end;

function checkFilename(tempchar: string; SourceStr: string): string; //去掉filemae中的s除去空格
var
  temp, stemp: string;
  i: integer;
begin
  temp := '';
  for i := 0 to Length(SourceStr) do
  begin
    stemp := copy(SourceStr, i + 1, 1);
    if (stemp <> tempchar) then
      temp := temp + stemp;
  end;
  result := temp;
end;

function GetUSB232com: string;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.OpenKey('hardware\devicemap\serialcomm', false);
    Result := reg.ReadString('\Device\USBSER000');
  finally
    reg.Free;
  end;
end;
end.