common.pas

作为服务

unit common;

interface
uses ExtCtrls, sysutils,forms,windows,messages,Classes,IniFiles,Registry,math,DateUtils,Graphics;


const

   cFlashTime=5000;        //报警信息窗口自动停留时间
   cLogLineCount=100;      //显示的日志总行数

type  //读系统参数。
  TSTID =array[1..10] of char;

  TSysInfo = record
     CenterNO     :string;
     CenterName    :string;
     HideTaskBar   :integer;       //隐藏任务栏
     RebootSystem  :integer;       //重新启动计算机
     chatmode      :boolean;

     videoCtrlPort :integer;      //矩阵控制服务器的网络端口
     videoCtrlIP   :string;       //矩阵控制服务器的网络IP地址

     cmsCtrlIP     :string;       //情报板控制服务器的网络端口
     cmsCtrlPort   :integer;      //情报板控制服务器的网络IP地址

     video1outID    :string;      //视频采集卡1连接到矩阵的输出端口
     VideoOutCount  :integer;     //矩阵视频输出总数

     UDPSERVER :string;           //广播数据的通讯计算机IP地址
     UDPLPORT  :INTEGER;          //广播数据的通讯计算机本地端口
     UDPRPORT  :integer;           //广播数据的通讯计算机远程端口

     ETUDPIP      :string;
     ETUDPLPORT   :INTEGER;
     ETUDPRPORT   :integer;

//     CMSServerPORT :integer;  //与大屏幕计算机联接监听端口

     /// 交通流参数配置
     cNormalLaneMinOcc  :integer;
     csuperLaneMinOcc   :integer;
     cNormalLaneMaxSpeed:integer;
     csuperLaneMaxSpeed :integer;
     cNormalLaneMaxOcc  :integer;
     csuperLaneMaxOcc   :integer;
     cNormalLaneMinSpeed:integer;
     csuperLaneMinSpeed :integer;
     cVisAlertValue1:integer;
     cVisAlertValue2:integer;

    DBServerHost    :string;        //数据库服务器名
    DatabaseName    :string;        //网络数据库名
    Mode            :string;        //登录方式
    UserID          :string;        //数据库登录用户
    Password        :string;        //数据库登录密码
  end;
  // Declaration from VC++ WINUSER.H
  //
  PKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
  KBDLLHOOKSTRUCT = record
    vkCode: DWORD;
    scanCode: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: DWORD;
  end;

////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
  procedure MsgToFile(  Msg:String);
  procedure SQLToFile( sqlstr:String);
//---消息框---
  procedure Prompt(Msg : string);
  procedure Alert(Msg : string);
  function  Confirm(Msg : string) : boolean;
  function  QueryInfo(Msg : string) : integer ;
  function  getFileExtName(FileName: string): string;
  
 
  function  CreateConnStr:string;
  function  CheckLocalSystemTime(TTime:TDatetime):boolean;


  function  SetPrivilege(sPrivilegeName: string; bEnabled: boolean ): boolean;
  function  WinExitInNT( iFlags : integer ) : boolean;

//数据格式转化
  function   StrReverse(str:string):string;
  function   HexToDec(hexvalue: string): integer;   //十六进制到十进制
  function   IntToBin(intValue: integer): string;   //十进制到二进制
  function   DecToHexEx(i: int64;ResultLen:integer): string;     //十进制到十六进制转换
  function   StrTohexEx(sendstr:string):string;                 //字符串到十六进制转换
  function  BinToInt(Binstr: string): integer;          //二进制到十进制


//情报板使用函数
  function   transferTColorToCCCStr(s:TColor):string;
  function   transferStrToTColor(s:string):TColor;  //for情报板用
  procedure  StringToCharArray(str:string;var outstr: array of char)  ;
  function   clearsubString(substr,str:string):string;
  procedure  splitToList(sourceStr,splitStr:String; s:TStrings);
  function   processCMSContent(sourceStr:TStrings;flag:integer):String;
  function   processCMSLibToFile(cmslib:string) :String;
  procedure  ListDirectoryPathAnyFile(FileList: Tstrings;DirectoryPath:string);




//系统热键注册与取消
  function  ProcessShiftState(ss:TShiftState):Cardinal;
  function  RegSysHotKey(Handle:THandle):boolean;
  function  UnRegSysHotKey(Handle:THandle):boolean;

//图形化参数
  function  bmp_rotate(src:tbitmap;var Dst:tbitmap; angle:extended):boolean;
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
var
  gpath       :string;
  gUserName   :string='Manager';
  guserID     :string='0000000000';
  blogin      :boolean =false;
 
  cbIsMoveIcon :boolean =false;
  bdrawDvcState    :boolean =false;     //是否显示设备状态
  bShowWSAlertInfo :boolean =false;     //是否显示气象报警数据
  bShowVDAlertInfo :boolean =false;     //是否显示车检报警数据
  bVDLaneBlockAlert:boolean =false;    //是否显示道路杜塞联动报警
  bVDLaneJamAlert  :boolean =false;      //是否显示道路饱和联动报警
  bVISLowAlert     :boolean =false;      //是否显示能见度低联动报警

  CmsFlashInt :Smallint =1000;  //情报板模拟显示时间间隔。毫秒

  SqlString:string;
  Myini:TInifile;
  SysInfo:TSysInfo;

  dHalfWidth ,dHalfHeight :integer;

  FTaskbarRestart: Longword;
  hhkNTKeyboard: HHOOK; // 钩子句柄

// 主界面地图显示参数
  THeight :integer= 80;
  BHeight :integer= 140;
  LWidth  :integer= 14;
  RWidth  :integer= 14;
//系统设置热键注册值
  HotKeyId: Integer;
  Key: word;
  ShiftState: Cardinal;

implementation




////////////////////////////////////////////////////////////////////////////////
/// 主要是记录系统日志错误                                                   ///
////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
//*************************************
//反转字符串
//*************************************
function StrReverse(str:string):string;
var
  i:integer;
begin
  Result:='';
  for i:=Length(str) downto 1 do
    Result:=Result+str[i];
end;

function HexToDec(hexvalue: string): integer;
begin
  Result:=StrToInt('$'+hexvalue);
end;


//*************************************
//十进制到16进制转换
//*************************************
function DecToHexEx(i: int64;ResultLen:integer): string;
var
  divisor,j,tmpi:int64;
  str:string;
begin
  divisor:=i;
  j:=i;
  str:='';
  while j<>0 do
  begin
    j:= j div 16;
    tmpi:=divisor-j*16;
    if tmpi<10 then
      str:=str+IntToStr(tmpi)
    else
      str:=str+Chr(tmpi-10+65);
    divisor:=j;
  end;
  Result:=str;
  if Result='' then Result:='0';
  Result:=StrReverse(Result);
  Result:=Copy('00000000000000',1,ResultLen-Length(Result))+Result;
end;
////////////////////////////////////////////////////////////////////////////////
// 功能 ：将字符串中的每一个字符转换为16进制的字符输出
//
////////////////////////////////////////////////////////////////////////////////
function   StrTohexEx(sendstr:string):string;
var  i:integer;
     res :string;
begin
  res:='';
  for i:=1 to  length(sendstr) do
  begin
    res :=res + dectohexex(ord(sendstr[i]),2)+' ';
  end;
  result :=res;
end;
procedure MsgToFile( Msg:String);
var
  F: Text;
  LogFile:string;
begin
  if not DirectoryExists(gpath +'LOGS') then
    if not CreateDir(gpath +'LOGS') then  raise Exception.Create('不能创建Log目录 ');

  LogFile:= gpath +'SystemError'+Formatdatetime('yyyymm',now)+'.Log';
  {$I-}
  AssignFile(F, LogFile);
  if FileExists(LogFile) then
    Append(F)
  else
    Rewrite(F);
  Writeln(F,  Formatdatetime('yyyy-mm-dd hh:nn:ss',now)+'   Msg:='+Msg);
  CloseFile(F);
  {$I+}
end;
////////////////////////////////////////////////////////////////////////////////
/// 主要是记录数据库操作日志                                                 ///
////////////////////////////////////////////////////////////////////////////////
procedure SQLToFile( sqlstr:String);
var
  F: Text;
  LogFile:string;
begin
  if not DirectoryExists(gpath +'SQL') then
    if not CreateDir(gpath +'SQL') then  raise Exception.Create('不能创建SQL目录 ');
  LogFile:= gpath +'SQL\sql'+Formatdatetime('yyyymmdd',now)+'.sql';
  {$I-}
  AssignFile(F, LogFile);
  if FileExists(LogFile) then
    Append(F)
  else
    Rewrite(F);
//  Writeln(F,  '【'+Formatdatetime('yyyy-mm-dd hh:nn:ss',now)+'】');
  Writeln(F,  sqlstr);
  CloseFile(F);
  {$I+}
end;
//*************************************
//提示
//*************************************
procedure Prompt(Msg : string);
begin
  Application.MessageBox(PChar(Msg), PChar('提示'), MB_ICONINFORMATION or Mb_OK);
end;

//*************************************
//警告
//*************************************
procedure Alert(Msg : string);
begin
  Application.MessageBox(PChar(Msg), PChar('警告'), MB_ICONWARNING or Mb_OK);
end;

//*************************************
//询问
//*************************************
function Confirm(Msg : string) : boolean;
begin
  Result := (Application.MessageBox(PChar(Msg), PChar('询问'), MB_ICONQUESTION or MB_OKCancel) = Id_Ok);
end;

//*************************************
//询问
//yes = 1 , no = 2 , cancel = 0
//*************************************
function QueryInfo(Msg : string) : integer ;
var i : integer ;
begin
  i := Application.MessageBox(PChar(Msg), PChar('询问'), MB_ICONQUESTION or MB_YESNOCancel) ;
  if i = IDYES then Result := 1
  else if i =IDNO then Result := 2
  else Result := 0 ;
end;

function getFileExtName(FileName: string): string;
var I:integer;
    s:string;
begin
  s:='';
  for I:= length(Filename) downto 0 do
  begin
    if FileName[i]<>'.' then
      s:=FileName[i]+s
    else
      break;
  end;
   result:=s;
end;

function  CreateConnStr:string;
var
  NetConnectStr:string;
begin
  result:='';
  NetConnectStr := 'Provider=SQLOLEDB.1';
  if SysInfo.Mode='NTOnly' then
  begin
        NetConnectStr := NetConnectStr + 'Integrated Security=SSPI';
  end;

  NetConnectStr := NetConnectStr + ';Persist Security Info=true;User ID='+SysInfo.UserID+';Password='+SysInfo.Password;
  NetConnectStr := NetConnectStr + ';Initial Catalog=' + SysInfo.DatabaseName;
  NetConnectStr := NetConnectStr + ';Data Source=' + SysInfo.DBServerHost;
  NetConnectStr := NetConnectStr + ';Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096';
  NetConnectStr := NetConnectStr + ';Use Encryption for Data=False;Tag with column collation when possible=False';
  result := NetConnectStr;
end;
//设置本地系统时间
///////////////////////////////////////////////////////////////////////////////
function   CheckLocalSystemTime(TTime:TDatetime):boolean;
var
  systime :systemtime;
begin
  result := false;