unit_publicinfo.pas

影院售票系统完整源码

end;

function  GetLocalIP: String;
type
  TaPInAddr = array [0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe  : PHostEnt;
  pptr : PaPInAddr;
  Buffer : array [0..63] of char;
  I    : Integer;
  GInitData      : TWSADATA;
begin
  WSAStartup($101, GInitData);
  try
    Result:='';
    GetHostName(Buffer, SizeOf(Buffer));
    phe :=GetHostByName(buffer);
    if phe = nil then Exit;
    pptr := PaPInAddr(Phe^.h_addr_list);
    I := 0;
    while pptr^[I] <> nil do
    begin
        result:=StrPas(inet_ntoa(pptr^[I]^));
        Inc(I);
    end;
  finally
    WSACleanup;
  end;
end;

function  GetLocalComputerName: String;
var
  ComputerName: array[0..MAX_COMPUTERNAME_LENGTH+1] of char;  // holds the name
  Size: DWORD;                                              // holds the size
begin
  Size := MAX_COMPUTERNAME_LENGTH+1;
  if GetComputerName(ComputerName, Size) then
  result := StrPas(Computername)
end;

function GetPYIndexChar( hzchar:string):char;
begin
  case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
      $B0A1..$B0C4 : result := 'A';
      $B0C5..$B2C0 : result := 'B';
      $B2C1..$B4ED : result := 'C';
      $B4EE..$B6E9 : result := 'D';
      $B6EA..$B7A1 : result := 'E';
      $B7A2..$B8C0 : result := 'F';
      $B8C1..$B9FD : result := 'G';
      $B9FE..$BBF6 : result := 'H';
      $BBF7..$BFA5 : result := 'J';
      $BFA6..$C0AB : result := 'K';
      $C0AC..$C2E7 : result := 'L';
      $C2E8..$C4C2 : result := 'M';
      $C4C3..$C5B5 : result := 'N';
      $C5B6..$C5BD : result := 'O';
      $C5BE..$C6D9 : result := 'P';
      $C6DA..$C8BA : result := 'Q';
      $C8BB..$C8F5 : result := 'R';
      $C8F6..$CBF9 : result := 'S';
      $CBFA..$CDD9 : result := 'T';
      $CDDA..$CEF3 : result := 'W';
      $CEF4..$D1B8 : result := 'X';
      $D1B9..$D4D0 : result := 'Y';
      $D4D1..$D7F9 : result := 'Z';
  else
      result := char(32);
  end;
end;

function QueryPy(hzstr:String):String;
var
  i: Integer;
  PY: string;
  s: string;
begin
  s := '' ;
  i := 1;
  while i <= Length(hzstr) do
  begin
    PY := Copy(hzstr, i , 1);
    if PY >= Chr(128) then
    begin
      Inc(i);
      PY := PY + Copy(hzstr, i , 1);
      s := s + GetPYIndexChar(PY);
    end
    else
      s := s + PY;
    Inc(i);
  end;
  result := LowerCase(s);
end;


procedure ListViewCustomDrawItem(Item: TListItem;var DefaultDraw: Boolean);
begin
  DefaultDraw:=false;
  if  odd(item.Index)   then
     item.ListView.Canvas.Brush.Color:=publicinfo.DoubleLineColor//$00CAF3BE
  else
     item.ListView.Canvas.Brush.Color:=publicinfo.SigleLineColor ;//$00EBFBE6;
  DefaultDraw:=true;
end;
procedure frmview(frm:TForm);
var
  i     :integer;
begin
  for i:=0 to frm.ComponentCount -1 do
  begin
    if (frm.components[i] is TCyberEdit) then
       (frm.components[i] as TCyberEdit ).Enabled  :=false
    else if (frm.components[i] is TCyberMemo) then
       (frm.components[i] as TCyberMemo ).ReadOnly  :=True
    else if (frm.components[i] is TCyberComboBox) then
       (frm.components[i] as TCyberComboBox ).Enabled  :=false
    else if (frm.components[i] is TCyberDateTimePicker) then
       (frm.components[i] as TCyberDateTimePicker ).Enabled  :=false
    else if (frm.components[i] is TEdit) or (frm.components[i] is TmaskEdit) then
       TEdit(frm.components[i]).Enabled :=false
    else if (frm.components[i] is TComboBox) then
       (frm.components[i] as TComboBox ).Enabled  :=false
    else if (frm.components[i] is TDateTimePicker) then
       (frm.components[i] as TDateTimePicker ).Enabled  :=false
    else if (frm.components[i] is TMemo) then
       (frm.components[i] as TMemo ).ReadOnly  :=True
    else if (frm.components[i] is TRichEdit) then
       (frm.components[i] as TRichEdit ).ReadOnly   :=True;
  end;
end;

procedure ExportToExcel(frm:TForm;LstV:TListView;caption:string;progressbar:TProgressbar);
var
  i,j           :integer;
  colcount,colnum:integer;
  item0         :TListItem;
  Excel,Sheet,rang:Variant;
  tmpstr        :string;
  collab        :string;
  recordcount1  :integer;
  ColList       :TStringList;
begin
  collist:=TStringList.Create ;
  recordcount1:=LstV.Items.Count ;
  if  recordcount1<=0 then exit;
  screen.Cursor :=crhourglass;
  try
    //定义打印列
    publicinfo.ReturnItem.Clear ;
    for i:=0 to LstV.Columns.Count-1 do
    begin
       publicinfo.ReturnItem.Add(LstV.Columns.Items[i].Caption) ;
    end;
    publicinfo.Request(1600);
    if publicinfo.ReturnItem.Count<=0 then exit;
    ColList.AddStrings(TStrings(publicinfo.ReturnItem)) ;
    publicinfo.ReturnItem.Clear ;
    if collist.Count <0 then exit;
    //
    Try
      Excel:=UnAssigned;
      Excel:=CreateOleObject('Excel.Application');
      Excel.Visible:=False;
      Excel.WorkBooks.Add;
    Except
      Excel.quit;
      Excel:=UnAssigned;
      application.MessageBox('本机未安装EXCEL,本功能必须在安装有EXCEL的电脑上才能运行!','必须安装EXCEL',mb_ok);
    End;
    if VarIsEmpty(Excel) then
    begin
      application.MessageBox('建立Excel对象不成功，请重试!','建立Excel对象',mb_ok);
      Excel.quit;
      Excel:=UnAssigned;
    end;
    try
      if trim(caption)='' then caption:='汇总表';
      sheet:=Excel.worksheets[1];
      Sheet.Name:=caption;
      Excel.WorkSheets[1].Activate;
      Excel.ActiveSheet.PageSetup.Orientation := 2;
      Excel.ActiveSheet.PageSetup.CenterHeader :=caption;
      Excel.ActiveSheet.PageSetup.CenterFooter := '第&P页  共&N页';
      Excel.ActiveSheet.PageSetup.HeaderMargin := 1/0.035;
      Excel.ActiveSheet.PageSetup.FooterMargin := 1/0.035;
      Excel.ActiveSheet.PageSetup.TopMargin := 2/0.035;
      Excel.ActiveSheet.PageSetup.LeftMargin := 1.5/0.035;
      Excel.ActiveSheet.PageSetup.RightMargin := 1.5/0.035;
      Excel.ActiveSheet.PageSetup.BottomMargin :=2/0.035;
      colcount:=ColList.Count;
      For I:=0 To colcount-1  Do
      begin
        colnum:=strtoint(ColList.Strings[i]);
        if (pos('▲',LstV.Columns[colnum].Caption)>0)
           or (pos('▼',LstV.Columns[colnum].Caption)>0) then
           Sheet.Cells[1,i+1]:=copy(LstV.Columns[colnum].Caption,1,length(LstV.Columns[colnum].Caption)-1)  //设置列标题
        else
           Sheet.Cells[1,i+1]:=LstV.Columns[colnum].Caption;  //设置列标题
        //Excel.ActiveSheet.Columns[i].ColumnWidth:=LstV.Columns[colnum].Width/100 ;
      end;
      if progressbar<>nil then
      begin
         progressbar.Visible :=true;
         progressbar.Max :=recordcount1;
      end;
      for i:=1 to recordcount1 do
      begin
        item0:=LstV.Items[i-1];
        for j:=0 to colcount-1  do
        begin
          colnum:=strtoint(ColList.Strings[j]);
          if colnum=0 then
             sheet.cells[(1+i),j+1]:=item0.Caption
          else
             sheet.cells[(1+i),j+1]:=item0.SubItems[colnum-1];
        end;
        if progressbar<>nil then progressbar.Position:=i;
      end;
      sheet.cells[recordcount1+3,1]:='制表日期：'+FormatDateTime('yyyy"年"mm"月"dd"日"',Now);
      if colcount>2 then
         Sheet.Cells[recordcount1+3,colcount-1]:='制表人：'+publicinfo.OperName    //以上为表头输出
      else
         Sheet.Cells[recordcount1+3,2]:='制表人：'+publicinfo.OperName ;
      //所有行
      collab:=char(65+colcount-1);
      tmpstr:='A1:'+collab+inttostr(recordcount1+1);
      rang:=sheet.range[tmpstr] ;
      rang.font.size:=9;
      rang.VerticalAlignment:=2;
      rang.Borders.LineStyle:=1;
      //第一行
      tmpstr:='A1:'+collab+'1';
      sheet.Range[tmpstr].select;
      Excel.selection.columnwidth:=15;
      Excel.Selection.HorizontalAlignment:=3;
      Excel.Selection.VerticalAlignment:=2;
      Excel.Selection.font.size    :=12;
    finally
      Excel.Visible:=True;
      Excel.ActiveSheet.PrintPreview;
      Excel:=UnAssigned;
    end;
  finally
    screen.Cursor :=crdefault;
    collist.Free ;
  end;
end;
{--------------以上定义公共函数------------------------------------------------------}
{--------------以下定义公共信息类----------------------------------------------------}

procedure TPublicInfo.ConnectAppServer(Connect: TCommClient);
begin
  if Connect.Active then  Connect.Active:=false;

  Connect.Host    := AppServerIP;
  Connect.Port    := AppServerPort ;
  Connect.TimeOut := ConnectTiemOut;

  if not Connect.Active then
  try
    Connect.Active := true;
  except
    on E: Exception do
    begin
      MessageDlg('连接服务器失败：' + E.Message, mtError, [mbOK], 0);
      Exit;
    end;
  end;

  if not Connect.Active then
      MessageDlg('连接服务器失败!' ,mtError, [mbOK], 0);
end;

constructor TPublicInfo.Create;
var
  _FileName:String;
begin
  inherited;
  PubConnection  := TCommClient.Create(nil);  //连接类1
  PriConnection  := TCommClient.Create(nil);  //连接类2
  CommandFileList:= TCommandFileList.Create;         //动态连接库列表
  MenuList       := TMenuList.Create;               //动态连接库功能列表
  UserMenuList   := TMenuList.Create;               //用户菜单功能列表
  FunctionList   := TFunctionList.Create;           //操作员功能列表
  ReturnItem     := TStringList.Create;             //*返回的字符列表
  Sysparams      := new(PSysparams);
  flowobject     := New(Pflowobject);
  MACAddress     := GetMACAddress;
  ComputerName   := GetLocalComputerName;
  IPAddress      := GetLocalIP;

  _FileName := ExtractFileDir(ParamStr(0))+'\CyberClient.ini';
  if ( not FileExists(_FileName) ) then
  begin
      Application.MessageBox(pchar('配置文件不存在!'),pchar('警告'),MB_OK);
      exit;
  end;
  CommandFileList.LoadFromFile(_FileName);           //初始化动态连接库列表!

  //初始化参数!
  InitParams;
  //以下初始化数据!
  AppHandle      := Application.handle ;             //应用程序句柄
  AppIcon        := Application.Icon;                //应用程序图标
  app:=application;
end;

destructor TPublicInfo.Destroy;
begin
  PubConnection.Free;
  PriConnection.Free;
  MenuList.Clear;
  MenuList.Free;
  UserMenuList.Clear;
  UserMenuList.Free;
  FunctionList.Clear;
  FunctionList.Free;
  CommandFileList.ClearAll;
  CommandFileList.Destroy;
  Dispose(Sysparams);
  Dispose(flowobject);
  ReturnItem.Free;
  inherited;
end;

procedure TPublicInfo.InitParams;
var
  MyIniFile         : TIniFile;
  _FileName,_Server : String;
  _Port,_TimeOut,_irunningmode    : Integer;
  _flowid:integer;
  _flowname:string;
begin

  _FileName :=ExtractFileDir(ParamStr(0))+'\DLLFiles';

  if not DirectoryExists(_FileName) then
  begin
    if not CreateDir(_FileName) then
    begin
       raise Exception.Create('不能创建目录'+_FileName);
    end;
  end;
  _FileName := ExtractFileDir(ParamStr(0))+'\CyberClient.ini';

  if ( not FileExists(_FileName) ) then
  begin
    Application.MessageBox(pchar('配置文件不存在!'),pchar('警告'),MB_OK);
    exit;
  end;

  MyIniFile := TIniFile.Create(_FileName);
  _Server        := MyIniFile.ReadString('SysConfig',  'AsServer'       ,'127.0.0.1');
  _Port          := MyIniFile.ReadInteger('SysConfig', 'AsPort'         ,8090);
  _TimeOut       := MyIniFile.ReadInteger('SysConfig', 'AsTimeOut'      ,0);
  _irunningmode  := MyIniFile.ReadInteger('SysConfig', 'StartWizard'    ,1);
  _flowid        := MyIniFile.ReadInteger('SysConfig', 'Flowid'         ,1);
  _flowname      :=MyIniFile.ReadString('SysConfig', 'flowname'         ,'');
  application.Title :=MyIniFile.ReadString('SysConfig','AppTitle','政府采购系统');
  OperCode       :=MyIniFile.ReadString('SysConfig', 'opercode'         ,'admin');
  siglelinecolor :=MyIniFile.ReadInteger('SysConfig', 'siglecolor'       ,$00CAF3BE);
  doublelinecolor:=MyIniFile.ReadInteger('SysConfig', 'doublecolor'      ,$00EBFBE6);
  MyIniFile.Free;

  AppServerIP    := _Server;
  AppServerPort  := _Port;
  ConnectTiemOut := _TimeOut;
  RunningMode    := IntToStr(_irunningmode);
  FlowTypeID     :=_flowid;
  flowname       :=_flowname;
end;

procedure TPublicInfo.Request(_MenuCode:Integer);
var
  Index         : Integer;
  Ptr           : PMenuNode;
  PathName      : String;
  successed     :Boolean;
  Entry         :TEntry;
  LibModule     :HMODULE;
begin
  MenuID := _MenuCode;
  Index := MenuList.IndexOf_Code(MenuID);
  if Index >= 0 then
     begin
       PathName := ExtractFileDir(ParamStr(0))+'\DLLFiles\';

       Ptr := MenuList.Items[Index];
       LibModule := LoadLibrary(Pchar(PathName+ Ptr^.DLLName));
       if LibModule = 0 then
          MessageDlg('加载动态连接库' + PathName + '出错：' + IntToStr(GetLastError), mtError, [mbOK], 0)
       else
          begin
            @Entry := GetProcAddress(LibModule, 'Entry');
            if @Entry = nil then
               begin
                 LibModule := 0;
                 MessageDlg('动态连接库' + PathName + '中的入口函数Entry错误：' + IntToStr(GetLastError), mtError, [mbOK], 0);