unit_publicinfo.pas

影院售票系统完整源码

{------------------------------------------------------------------------------

                  MayHua Client  1.0

      Copyright (c) 2002,05 MayHua Corporation

        *Author     :  刘迪仲,张晓峰

        *LastUpdated:  2002-08-02

        *SourceName :  unit_PublicInfo.pas

        功      能  :


        更 新 列 表 :

--------------------------------------------------------------------------------}
unit unit_PublicInfo;

interface

uses
  Windows,Graphics,Classes,SysUtils,ComCtrls,StdCtrls,Forms,Dialogs,
  Messages,Controls,Variants,comobj,ExtCtrls,IniFiles,Winsock,Mask,encddecd,zlib,
  NB30,menus,Buttons,CyberEdit,CyberCmboBx,unit_TCommClient;
  const LoopCount       =3;
  const signcolor       =clred;
  const contract_generalquery =5400;
  const generalreport   =8000;
  const BuyerItem_query =8001;
  const SellerBid_query =8002;
  const Yearbuysum_query=8003;

  const AuditPass       ='1';
  const AuditNotPass    ='0';
  const NotAudit        ='6';
  //公用函数
  function  GetPYIndexChar( hzchar:string):char;
  function  QueryPy(hzstr:String):String;        //取拼音码!
  function  GetLocalComputerName: String;
  function  GetLocalIP: String;
  function  GetMACAddress: String;
  function  GetFileVersion(filename:String):String;
  function  GetDecodedBase64(const AFileName:string):string;  //压缩文件
  function  GetEncodedBase64(SourceStr:string):string;       //得到解压后的字符!
  procedure LogOutPut(msgType:Integer;LineStr:String;client:String);   //日志输出!
  procedure ListViewCustomDrawItem(Item: TListItem;var DefaultDraw: Boolean);
  procedure frmview(frm:TForm);
  procedure ExportToExcel(frm:TForm;LstV:TListView;caption:string;progressbar:TProgressbar);
type
//----------------------以下定义我自己的配置文件队列-------------------------------------*/
  PTCommandFileNode =^TCommandFileNode;

  TCommandFileNode = record
     FileName     : String;           //"e:\conf\xtgl.dll"
     Caption      : String;           //"系统管理模块"
     Version      : String;           //1.1.0.9
     ID           : Integer;          //序号!
     Panel        : TPanel;           //显示的Panel
     ParentPanel  : TPanel;           //父Panel;
     Color        : Integer;          //显示的颜色!
     LibModule    : HMODULE;          // 0表示没有装载
     Form         : TForm;            //主窗体!
  end; //定义命令结点

  TCommandFileList = class(TList)   //模块列表
  private

  protected
  public
     function   Add(myNode: PTCommandFileNode):Boolean;    //增加接点
     function   Dele(index:Integer):Boolean;               //删除接点
     function   Dele2(inifile:String):Boolean;
     function   Exists(inifile:String):Boolean;            //判断配置文件是否存在?
     procedure  LoadFromFile(inifile:String);              //根据某个配置文件初始化列表
     procedure  SaveToFile(inifile:String);                //保存到某个配置文件中!
     procedure  ClearAll();
     procedure  ClearFromScreen;
     destructor Destroy;override;
     procedure  ShowList;                   //调试链表
  end;
//----------------------以上定义我自己的配置文件队列-------------------------------------*/
//----------------------以下定义我自己的菜单队列-----------------------------------------*/
  PMenuNode = ^TMenuNode;              //公用功能DLL结构
  TMenuNode = record
     ID            : Integer;   //唯一标识
     ModuleCode    : String;    //模块号
     Code          : String;    //功能号
     Name          : String;    //名称
     DLLName       : String;    //文件名
     IsPublic      : Boolean;
  end;

  TMenuList = class(TList)       //所有界面功能列表
  private
  protected
     procedure   Notify(Ptr: Pointer; Action: TListNotification); override;
  public
     constructor Create;
     function    IndexOf(RequestID: Integer): Integer;
     function    IndexOf_Code(_MenuCode: Integer): Integer;
     function    GetCode(MenuID: Integer): Integer;
     function    GetDLLFile(_menuid:Integer):String;
     function    Add(ID: Integer;Mcode,code,name,Dllname:String;ispublic:boolean): Integer; overload;
  end;
//----------------------以上定义我自己的菜单队列-----------------------------------------*/
//----------------------以下定义我自己的功能队列-----------------------------------------*/
  PFunctionNode = ^TFunctionNode;              //公用功能DLL结构
  TFunctionNode = record
     ID            : Integer;   //唯一标识
     MenuID        : Integer;   //隶属菜单标识
     Code          : String;    //功能号
     Name          : String;    //名称
     TriggerObject : String;    //触发对象
  end;

  TFunctionList = class(TList)       //用户权限功能列表
  private
  protected
     procedure   Notify(Ptr: Pointer; Action: TListNotification); override;
  public
     constructor Create;
     function    IndexOf(FuncCode: String): Integer;
     function    Exitfunctionname(functionname:string):boolean;
     function    ExistsTriggerObject(_triobject: String): Boolean;
     function    Add(ID,MenuId: Integer;code,name,TriObject: string): Integer; overload;
  end;

  PSysparams= ^TSysparams;         //系统参数
  TSysparams = record
     BidSaleFundIsUsed  :Boolean;
     EnsureFundIsUsed   :Boolean;
     EnsureFundscale    :Single;    //
     PerformFundIsUsed  :Boolean;
     PerformFundScale   :Single;    //
     ServiceFundIsUsed  :Boolean;
     ServiceFundScale   :Single;    //
  end;
  Pflowobject= ^Tflowobject;         //系统参数
  Tflowobject = record
     ID         : Integer;
     Flowid     : Integer;
     Functionid : Integer;
     ObjectID   : Integer;
     Director   : Integer;
     ObjectCode : String;
     wheresqlstr: String;
  end;
//----------------------以上定义我自己的功能队列-----------------------------------------*/

  TPublicInfo = Class(TObject)             //公用信息的结构
  private
  public
     OperID         : Integer;                    //操作员ID
     OperCode       : String;                     //操作员登陆号
     OperName       : String;                     //操作员姓名
     OperGroupID    : Integer;                    //操作员组别ID
     Deptid         : Integer;                    //所属部门
     Password       : String;                     //操作员密码
     MACAddress     : String;                     //网卡号
     ComputerName   : String;                     //计算机名
     IPAddress      : String;                     //本机IP地址
     PubConnection  : TCommClient;                //连接类,主要是公用!
     PriConnection  : TCommClient;                //私用连接类
     AppServerIP    : String;                     //应用服务器IP地址
     AppServerPort  : Integer;                    //应用服务器Port
     ConnectTiemOut : Integer;                    //连接超时设置
     AppHandle      : THandle;                    //应用程序句柄
     AppIcon        : TIcon;
     RunningMode    : string;                    //0=导航方式;1=菜单方式
     CommandFileList: TCommandFileList;           //动态连接库列表
     MenuList       : TMenuList;                  //所有菜单功能列表
     UserMenuList   : TMenuList;                  //获取用户所拥有的菜单功能列表
     FunctionList   : TFunctionList;              //操作员功能列表
     MenuID         : Integer;                    //*菜单标识号
     FuncCode       : String;                     //*功能号
     FlowTypeID     : Integer;                    //*流程类型号
     Flowname       : String ;                    //*流程类型名称
     SigleLineColor : TColor;                     //单行网格颜色
     DoubleLineColor: TColor;                     //双行网格颜色
     APP            : TApplication;               //*主程序句柄
     Sysparams      : PSysparams;                 //系统参数列表
     flowobject     : Pflowobject;                //流程单据信息
     ReturnItem     : TStringList;                //*返回的字符列表
     constructor  Create;overload;
     destructor   Destroy;override;
     procedure    InitParams;
     procedure    Getsysparams;

     procedure    ConnectAppServer(Connect:TCommClient);
     procedure    Clearflowobject;
     procedure    RequestFunc(_FuncCode:String);     //请求某个功能号=TFunction^.Code!
     procedure    RequestMenu(_MenuID:integer);      //请求某个菜单功能号!
     procedure    Request(_MenuCode:Integer);        //请求某个菜单功能号!

     { 若某个窗体要控制Button,则可以利用sys_functions和以下的函数来进行!
     以下函数在窗体打开后调用}
     procedure    InspectPopedom(targetForm:TForm);
     procedure    MenuFunPower(targetForm:TForm);
     //审核接口
     function     IsUsed(FunctionID:integer):Boolean;
     function     sendmsg(functionid,direction:integer;objectid:integer;objectcode,wheresqlstr:string):boolean;
     function     Audit(Auditopinion,AuditResult,updatesqlstr:string):integer;
  end;

  TEntry   = function(PubInfo:TPublicInfo):Boolean; stdcall;
  TEntryEx = function(PubInfo:TPublicInfo):TForm; stdcall;
var
  PublicInfo: TPublicInfo;

implementation
uses unit_flowfunction,pack;
{--------------以下定义公共函数------------------------------------------------------}
function  GetDecodedBase64(const AFileName:string):string;  //压缩文件
var
    ass,ass1:tstringstream;
    amm,amm1:tmemorystream;
    strtemp:string;
    mscompressedstream:tcompressionstream;
begin
    ass:=tstringstream.Create('');
    amm:=tmemorystream.Create ;
    ass1:=tstringstream.Create('');
    amm1:=tmemorystream.Create ;
    mscompressedstream:=tcompressionstream.Create(cldefault,amm1);
    try
        amm.LoadFromFile(afilename);
        amm.SaveToStream(ass);
        strtemp:=ass.DataString;
        try
          mscompressedstream.Write(strtemp[1],length(strtemp));
        finally
            mscompressedstream.Free ;
        end;
        amm1.Position :=0;
        amm1.SaveToStream(ass1);
        //encodestream(amm1,ass1);
        result:=encodestring(ass1.DataString);
    finally
        amm.Free;
        ass.Free;
        amm1.Free;
        ass1.Free ;
    end;

end;

function  GetEncodedBase64(SourceStr:string):string;  //得到解压后的字符!
var
    ass:tstringstream;
    amm,amm1:tmemoryStream;
    uncompressed:tdecompressionstream;
    fbuflen:integer;
    fbuffer:array[0..16383] of byte;
begin
    amm:=tmemoryStream.create;
    amm1:=tmemoryStream.create;
    ass:=tstringstream.Create(decodestring(SourceStr));
    amm1.LoadFromStream(ass);
    try
        amm.Size :=0;
        amm1.Position :=0;
        uncompressed:=tdecompressionstream.Create(amm1);
        try
                fbuflen:= uncompressed.Read(fbuffer,sizeof(fbuffer));
                while fbuflen>0 do
                begin
                        amm.Write(fbuffer,fbuflen);

                        fbuflen:=uncompressed.Read(fbuffer,sizeof(fbuffer));
                end;
        finally
              uncompressed.Free ;
        end;

        amm.Position :=0;
        setlength(result,amm.size);
        move(amm.memory^,result[1],amm.Size );

    finally
        ass.Free ;
        amm.Free ;
        amm1.Free ;
    end;

end;

procedure LogOutPut(msgType:Integer;LineStr:String;client:String);   //日志输出!
var
  _FileName: String;
  _Handle  : TextFile;
  fI:Integer;
begin

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

  if not DirectoryExists(_FileName) then
  begin
    if not CreateDir(_FileName) then
    begin
       raise Exception.Create('不能创建目录'+_FileName);
       exit;
    end;
  end;
  _FileName :=_Filename+'\log'+FormatDateTime('YYYYMMDD',Now)+'.txt';
  if not FileExists(_FileName) then
  begin
     fi :=  FileCreate(_FileName);
     FileClose(fi);
  end;

  try
     AssignFile(_Handle, _FileName);
  except
     Close(_Handle);
     exit;
  end;
  Append(_Handle);
  Writeln(_Handle,client+'|'+IntToStr(msgType)+'|'+FormatDateTime('YYYY-MM-DD HH:MM:SS',Now)+': '+LineStr);
  Flush(_Handle);
  CloseFile(_Handle);

end;


function  GetFileVersion(filename:String):String;
var
  InfoSize, Wnd: DWORD;
  VerBuf: Pointer;
  FI: PVSFixedFileInfo;
  VerSize: DWORD;
begin
  Result :='0.0.0.0';
  InfoSize := GetFileVersionInfoSize(PChar(filename), Wnd);
  if InfoSize > 0 then
  begin
    GetMem(VerBuf, InfoSize);
    try
      if GetFileVersionInfo(PChar(ParamStr(0)), Wnd, InfoSize, VerBuf) then
        if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then
          Result := Format('%d.%d.%d.%d',
              [HIWORD(FI.dwFileVersionMS), LOWORD(FI.dwFileVersionMS),
              HIWORD(FI.dwFileVersionLS), LOWORD(FI.dwFileVersionLS)]);
    finally
      FreeMem(VerBuf);
    end;
  end;
end;

function  GetMACAddress: String;
type
  TASTAT = packed record
    adapt: TAdapterStatus;
    NameBuff: array [0..29] of TNameBuffer;
  end;
var
  Adapter: TASTAT;
  ncb: TNCB;
  lana_enum: TLanaEnum;
  i, iNum, iPos: Integer;
begin
  Result := '000000000000';
  ZeroMemory(@ncb, SizeOf(ncb));
  ncb.ncb_command := Chr(NCBENUM);
  ncb.ncb_buffer := PChar(@lana_enum);
  ncb.ncb_length := SizeOf(lana_enum);
  if (Netbios(@ncb) = Chr(NRC_GOODRET)) then
  begin
    iNum := Ord(lana_enum.length);
    for i := 0 to iNum - 1 do
    begin
      ZeroMemory(@ncb, SizeOf(ncb));
      ncb.ncb_command := Chr(NCBRESET);
      ncb.ncb_lana_num := Chr(i);
      if (Netbios(@ncb) = Chr(NRC_GOODRET)) then
      begin
        ZeroMemory(@ncb, SizeOf(ncb));
      	ncb.ncb_command := Chr(NCBASTAT);
      	ncb.ncb_lana_num := Chr(i);
      	StrCopy(ncb.ncb_callname, '*               ');
      	ncb.ncb_buffer := @Adapter;
      	ncb.ncb_length := SizeOf(Adapter);
      	if (Netbios(@ncb) = Chr(NRC_GOODRET)) then
        begin
          if Adapter.adapt.adapter_type = Chr($FE) then // Ethernet adapter
          begin
            Result := Format('%2x%2x%2x%2x%2x%2x',
              [Ord(Adapter.adapt.adapter_address[0]), Ord(Adapter.adapt.adapter_address[1]),
              Ord(Adapter.adapt.adapter_address[2]), Ord(Adapter.adapt.adapter_address[3]),
              Ord(Adapter.adapt.adapter_address[4]), Ord(Adapter.adapt.adapter_address[5])]);
            for iPos := 1 to 12 do
              if Result[iPos] = ' ' then
                Result[iPos] := '0';
            Break;
          end;
        end;
      end;
    end;
  end;