?? 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;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -