ucommon.~pas

采用ACM与Skype4Com并且采用分布式UDP来进行语音的拨号、分传。

function gcf_Haier_AnalyseDeviceDataToDB(sDevice: string; fValue: Double): Boolean;

//海尔工业函数-将抽空中的台位编码及数据转移到抽空队列表中(已经完成测试,准备进行条码扫描的台位).
function gcf_Haier_TestingToQueueDB(sDevice: string): Boolean;

{**********************************************************************}
{                        Custom Procedure Area                         }
{                         用户自定义过程区域                           }
{**********************************************************************}

// 重置自动关闭对话框.
procedure gcp_ResetDlgAutoClose;

//指定的时间关闭对话框.  nTime:时间;  ADoHint:是否提示; 返回:默认为False;
procedure SetDlgAutoClose(nTime: Integer; ADoHint: Boolean; AReturn: Boolean = false);

//调用系统关于对话框   sTitle:标题 ; sContent:内容信息
procedure gcp_SystemAbout(sTitle, sContent: string);

// 获取计算机IP地址或计算机名称 装载到全局变量gComputerAddr,gComputerName中.
procedure gcp_GetComputerInfo;

//程序清除自毁
procedure gcp_DeleteMe;

//清空全局通用变量gCommVar记录结构体数据
procedure gcp_SetCommVarEmpty;

//获取窗体关闭时的相关状态。  objForm:要获取窗体并设置窗体的窗体实例.
procedure gcp_ReadFormControlStatus(objForm: TForm);

//保存窗体关闭时的相关状态。  objForm:要保存窗体并设置窗体的窗体实例.
procedure gcp_SaveFormControlStatus(objForm: TForm);

//重启应用程序本身
procedure gcp_AppRestart;

//防止应用程序多次运行
procedure gcp_AppMutex;

//显示Windows关于对话框
procedure gcp_AppAbout;

//程序自动运行      bYes:True 自动运行 Fals:不自动运行
procedure gcp_AppAutoRun(bYes: Boolean);

//显示系统日志信息   sInfo:日志信息  iStyle:样式 1:普通 2:警告 3:错误 4:系统
procedure gcp_AppShowLogs(objForm: TForm; sInfo: string; iStyle: Integer = 1);

//重启WINDOWS   0:关闭 1:重启 2:注销 3:关机
procedure gcp_SysClose(iSmallInt: SmallInt);

//检测DEDE反编译器,只对2.5版本以后的起作用.
procedure gcp_Anti_DeDe();

//根据指定的参数画不分层树。    objTreeView:  下拉列表实例   vFixedStr:显示的分隔符变量组  vTextName:显示的字符串变量组
//                            vDataFixedStr:  数据部分的分隔符变量组1     vDataName:数据部分变量组1
//                           vData2FixedStr:  数据部分的分隔符变量组2    vData2Name:数据部分变量组2
//                                  sConstr:  连接字符串      sSQLStr:SQL语句   iImageIndex:图标索引号
//                              bFirstClear:  是否先清空Combobox的Item项。
procedure gcp_DrawfcTreeView(objTreeView: TfcTreeView; vFixedStr, vTextName, vDataFixedStr, vDataName, vData2FixedStr, vData2Name: Variant;
  sConStr, sSQLStr: string; tckBoxType: TfcTreeViewCheckboxType = tvctNone; iImageIndex: Integer = -1; iSelectedIndex: Integer = -1;
  sTopItemName: string = ''; sLinkStr: string = DEF_ESEPCHAR + DEF_LINKCHAR + DEF_BSEPCHAR; bIsClear: Boolean = True);

//根据指定的参数画分层树。    objTreeView:  下拉列表实例   vFixedStr:显示的分隔符变量组  vTextName:显示的字符串变量组
//                           vData2FixedStr:  数据部分的分隔符变量组2    vData2Name:数据部分变量组2
//                                  sConstr:  连接字符串   sSQLStr:SQL语句   sDataName:节点ID号字段名  sPDataName:父节点ID号字段名
//                                  iImageIndex:图标索引号   iSelectedIndex:选择后的图标   sTopItemName: 头部标题内容
//                                 sLinkStr:默认的连接字符串 bFirstClear:  是否先清空Combobox的Item项。
procedure gcp_DrawLevelfcTreeView(objTreeView: TfcTreeView; vFixedStr, vTextName, vData2FixedStr, vData2Name: Variant;
  sConStr, sSQLStr, sDataName, sPDataName: string; tckBoxType: TfcTreeViewCheckboxType = tvctNone; iImageIndex: Integer = -1;
  iSelectedIndex: Integer = -1; sTopItemName: string = ''; sLinkStr: string = DEF_ESEPCHAR + DEF_LINKCHAR + DEF_BSEPCHAR;
  bIsClear: Boolean = True);

//展开或收缩选定节点的子节点所有项。    objTreeView:实例对象   objSelNode:节点对象   bExpanded:指定为展开或不展开
procedure gcp_TreeViewSelNodeExpanded(objTreeView: TfcTreeView; objSelNode: TfcTreeNode; bExpanded: Boolean = False);

//设置fcTree树得 Check值 状态  {子节点全选或全不选}    afcTree: 实力对象 afcNode:节点对象  abCheck 选或不选
procedure gcp_ChildNodeCheck(afcTree: TfcCustomTreeView; afcNode: TfcTreeNode; abChecked: Boolean = false);

//获取窗体关闭时的相关状态。 objForm:要操作的窗体;
procedure gcp_GetFormControlStatus(objForm: TForm);

//保存窗体关闭时的相关状态。 objForm:要操作的窗体;
procedure gcp_SetFormControlStatus(objForm: TForm);

//时间过程
procedure gcp_TimerProc(hWnd: THandle; uMsg: Integer; idEvent: Integer; dwTime: Integer);

//初始化时间过程
procedure gcp_TimeFunc(Sender: TObject);

//打开屏幕保护
procedure gcp_OpenScreenSave;

//=========================================================================================================================================================================================================

implementation

//引用Splash,Login,BasePrompt窗体
//******************************************************************************
// 函数功能: 通用对话框，与MessageBox类似，简化了一些繁琐的参数。
// 函数参数:  sInfo       String             要显示的信息
//            iTag        Integer            图标及按钮的一些标记
//            AppHandle   LongWord           所属的窗口句柄。
//   返回值: 返回通用对话框MessageBox所返回的值
//******************************************************************************

function gcf_MsgBox(sInfo: string; iTag: integer = 0; AppHandle: HWND = 0): Integer;
begin
  //DEF_AUTOCLOSEDLG ]
  SetDlgAutoClose(DEF_AUTOCLOSEDLG, true);
  if AppHandle = 0 then
  begin
    if iTag = 0 then
      Result := MessageBox(Application.Handle, PChar(sInfo), DEF_APPLDLGTITLE, MB_OK + MB_ICONINFORMATION + MB_APPLMODAL)
    else
      Result := MessageBox(Application.Handle, PChar(sInfo), DEF_APPLDLGTITLE, iTag);
  end
  else
  begin
    if iTag = 0 then
      Result := MessageBox(AppHandle, PChar(sInfo), DEF_APPLDLGTITLE, MB_OK + MB_ICONINFORMATION + MB_APPLMODAL)
    else
      Result := MessageBox(AppHandle, PChar(sInfo), DEF_APPLDLGTITLE, iTag);
  end;
end;


//******************************************************************************
// 函数功能: 加密函数（可逆向解密）
// 函数名称: gcf_EncryptCode
// 函数参数: strSource             预加密的字符串
//   返回值: 返回字符串加密后的内容。
//******************************************************************************

function gcf_EncryptCode(strSource: string): string;
var
  lsarrTemp: array of string;
  i: Integer;
  j: Integer;
  liCount: Integer;
  liRandom: Integer;
  liRandomCode: Integer;
  liRemain: Integer;
  lsResultStr, lsLeft, lsRight, lsMiddle: string;
begin
  Randomize;
  lsResultStr := '';
  if strSource = '' then
  begin
    Result := lsResultStr;
    Exit;
  end;

  SetLength(lsarrTemp, Length(strSource));
  liCount := 0;
  liRemain := 0;
  j := 0;
  while Length(strSource) <> 0 do
  begin
    lsarrTemp[liCount] := Copy(strSource, 1, 1);
    Delete(strSource, 1, 1);
    Inc(liCount);
  end;

  for i := Low(lsarrTemp) to High(lsarrTemp) do
  begin
    Randomize;
    liRandom := 0;
    while liRandom = 0 do
      liRandom := Random(1000);

    liRandomCode := 0;
    while liRandomCode = 0 do
    begin
      liRandomCode := Random(5);
      if liRandomCode = 5 then
        liRandomCode := 0;
    end;

    case liRandomCode of
      1:
        j := Word(lsarrTemp[i][1]) + liRandom;
      2:
        j := Word(lsarrTemp[i][1]) - liRandom;
      3:
        j := Word(lsarrTemp[i][1]) * liRandom;
      4:
        begin
          liRandom := 0;
          while liRandom = 0 do
          begin
            Randomize;
            liRandom := Random(20);
          end;
          liRemain := Word(lsarrTemp[i][1]) mod liRandom;
          j := Word(lsarrTemp[i][1]) div liRandom;
        end;
    else

    end;

    case liRandomCode of
      1, 2, 3:
        lsResultStr := lsResultStr + (IntToStr(j) + ',' + IntToStr(liRandom) +
          '.' + IntToStr(liRandomCode) + '#');
      4:
        lsResultStr := lsResultStr + (IntToStr(j) + ',' + IntToStr(liRandom) +
          '.' + IntToStr(liRandomCode) + '.' + IntToStr(liRemain) + '#');
    else

    end;
  end;
  lsLeft := Copy(lsResultStr, 1, 1);
  lsMiddle := Copy(lsResultStr, 2, Length(lsResultStr) - 2);
  lsRight := Copy(lsResultStr, Length(lsResultStr), 1);
  //RLRMRA  组合
  Randomize;
  lsResultStr := '#' + Format('%4d', [Random(9999)]) + lsLeft + lsRight + lsMiddle + (Format('%4d', [Random(9999)])) + '#';
  Result := lsResultStr;
end;


//******************************************************************************
// 函数功能: 解密函数（可逆向加密）
// 函数名称: gcf_UnEncryptCode
// 函数参数: strCode             预解密的字符串
//   返回值: 返回录入字符串解密后的内容。
//******************************************************************************

function gcf_UnEncryptCode(strCode: string): string;
var
  liCount: Integer;
  i: Integer;
  lsStr1: string;
  lsStr2: string;
  lsStr3: string;
  lsStr4: string;
  lsTempStr: string;
  lsResultStr, lsLeft, lsRight, lsMiddle, lsFullStr: string;
begin

  {若目标字符串为空字符串，则返回空的解密字符串}
  if strCode = '' then
    lsResultStr := '';

  liCount := 0;

  //字符串长度是否为偶数
  strCode := Copy(strCode, 6, Length(strCode) - 10);
  lsLeft := Copy(strCode, 1, 1);
  lsRight := Copy(strCode, 2, 1);
  lsMiddle := Copy(strCode, 3, Length(strCode));

  //RLM  组合
  lsFullStr := lsLeft + lsMiddle + lsRight;
  for i := 1 to Length(lsFullStr) do
    if Copy(lsFullStr, i, 1) = '#' then
      Inc(liCount);

  if liCount = 0 then
  begin
    Result := lsResultStr;
    Exit;
  end;

  while Length(lsFullStr) <> 0 do
  begin
    lsTempStr := Copy(lsFullStr, 1, Pos('#', lsFullStr) - 1);
    Delete(lsFullStr, 1, Pos('#', lsFullStr));
    lsStr1 := UpperCase(Copy(lsTempStr, 1, Pos(',', lsTempStr) - 1));
    Delete(lsTempStr, 1, Pos(',', lsTempStr));
    lsStr2 := Copy(lsTempStr, 1, Pos('.', lsTempStr) - 1);
    Delete(lsTempStr, 1, Pos('.', lsTempStr));
    if Pos('.', lsTempStr) <> 0 then
    begin
      lsStr3 := Copy(lsTempStr, 1, Pos('.', lsTempStr) - 1);
      Delete(lsTempStr, 1, Pos('.', lsTempStr));
      lsStr4 := lsTempStr;
    end
    else
    begin
      lsStr3 := lsTempStr;
      lsStr4 := '';
    end;

    try
      case StrToInt(lsStr3) of
        1:
          lsResultStr := lsResultStr + Char(StrToInt(lsStr1) -
            StrToInt(lsStr2));
        2:
          lsResultStr := lsResultStr + Char(StrToInt(lsStr1) +
            StrToInt(lsStr2));
        3:
          lsResultStr := lsResultStr +
            Char(StrToInt(lsStr1) div StrToInt(lsStr2));
        4: