delphi 常用函数库，2

isParadox:=(pos('.db',tempTableName)>0) and (tempTableName[length(tempTableName)]='b');

isDbase:=pos('.dbf',tempTableName)>0;

end

else

begin

isParadox:=TableType=ttParadox;

isDbase:=TableType=ttDbase;

end;

if isparadox or isDbase then

begin

bExclusive:=Exclusive;

bActive:=Active;

DisableControls;

// Close;

Exculsive:=true;

end

else

begin

StatusMsg:='无效的数据表类型。';

Exit;

end;

if isParadox then

begin

if wwMemAvail(Sizeof(CRTblDesc)) then

begin

StatusMsg:='内存不足，压缩表失败。';

end

else

begin

GetMem(pTblDesc,Sizeof(CRTblDesc));

fillchar(pTblDesc^,Sizeof(CRTblDesc),0);

with pTblDesc^ do

begin

strCopy(szTblName,Tablename);

strCopy(szTblType,szParadox);

Active:=True;

Check(DbiGetCursorProps(handle,Props));//检测是否右口令保护

bProtected:=props.bProtected;

Active:=False;

bPack:=True;

end;

Screen.Cursor:=crHourGlass;

SetDBFlag(dbfOpened,True);

rslt:=DBIdoRestructure(DBHandle,1,pTblDesc,nil,nil,nil,False);

if rslt<>DBIERR_NONE then

begin

DBiGetErrorString(rslt,SzErrMsg);

StatusMsg:=SzErrMsg;

end

else

Result:=True;

SetDBFlag(dbfOpened,False);

FreeMem(pTblDesc,Sizeof(CRTlDesc));

Screen.Cursor:=crDefault;

end;

end

else

if isDbase then

begin

Screen.Cursor:=crHourGlass;

OPen;

rslt:=dbiPacktable(DBHandle,Handle,nil,nil,True);

Screen.Cursor:=crDefault;

if rslt<>DBIERR_NONE then

begin

DBiGetERRorString(rslt,szErrMsg);

StatusMSg:=SzErrMsg;

end

else

Result:=True;

end;

Close;

Exculsive:=bExclusive;

Active:=bActive;

EnableControls;

end;}

{procedure CompactDb(DbName, NewDbName: string);

var

dao: OLEVariant;

begin

dao := CreateOleObject('DAO.DBEngine.35');

dao.CompactDatabase(DbName, NewDbName);

end;}

//修复Access表

procedure RepairDb(DbName: string);

var

Dao: OLEVariant;

begin

Dao := CreateOleObject('DAO.DBEngine.35');

Dao.RepairDatabase(DbName);

end;

//通过注册表创建ODBC配置[创建在系统DSN页下]

function CreateODBCCfgInRegistry(ODBCSourceName:WideString; ServerName, DataBaseDescription:String):boolean;

var

Reg: TRegistry;

LPT_systemDir:array [1..255] of char;

P:Pchar;

DriverString:String;

begin

Reg := TRegistry.Create;

Reg.RootKey := HKEY_LOCAL_MACHINE;

try

try

if not Reg.KeyExists('\Software\ODBC\ODBC.INI\'+trim(ODBCSourceName)) then

begin

//创建并打开主键。

if Reg.OpenKey('\Software\ODBC\ODBC.INI\'+trim(ODBCSourceName),True) then

begin

//写入键值

Reg.WriteString('DataBase', ODBCSourceName);

Reg.WriteString('Description',Trim(DataBaseDescription));

GetSystemDirectory(@LPT_systemDir,255) ;

P:=@LPT_systemDir;

DriverString:=StrCat(P,Pchar('\SQLSRV32.DLL')) ;

Reg.WriteString('Driver', DriverString);

Reg.WriteString('LastUser', 'Administrator');

Reg.WriteString('Server', trim(ServerName));

Reg.WriteString('Trusted_Connection', 'Yes');

reg.CloseKey;

end;

//加入ODBCDataSource

if Reg.OpenKey('\Software\ODBC\ODBC.INI\ODBC Data Sources\',True) then

begin

Reg.DeleteValue(ODBCSourceName);

Reg.WriteString(ODBCSourceName, 'SQL Server');

Reg.CloseKey;

end;

end;

Result:=True;

except

Result:=False;

end;

finally

Reg.Free;

end;

end;

function ADOConnectSysBase(Const Adocon:TadoConnection):boolean;

{* 用Ado连接SysBase数据库函数}

begin

with Adocon do

begin

Close;

LoginPrompt:=False; //若数据库不存在时，进行判断。。。。。。

ConnectionString:='Provider=MSDASQL.1;'+

'Password="";'+

'Persist Security Info=True;'+

'Data Source=Sy_Finalact';

try

KeepConnection:=True;

Screen.Cursor:=crHourGlass;

Connected:=True;

Open;

Screen.Cursor:=crDefault;

ADOConnectSysBase:=True;

except

ADOConnectSysBase:=False;

end;

end;

end;

//Ado连接数据库函数

function ADOConnectLocalDB(Const Adocon:TAdoConnection;Const Dbname,DBServerName:String;ValidateMode:Integer):boolean;

begin

with Adocon do

begin

Close;

LoginPrompt:=False; //若数据库不存在时，进行判断。。。。。。

if ValidateMode=0 then//使用Windows NT验证模式

ConnectionString:='Provider=SQLOLEDB.1;'+

'Password="";'+

'Integrated Security=SSPI;'+ //集成安全

'Persist Security Info=False;'+

'User +''''+dbname+''''+';'+

'Data Source='+''''+DBServerName+'''';

if ValidateMode=1 then//使用SQL SERVER验证模式

ConnectionString:='Provider=SQLOLEDB.1;'+

'Password="";'+

'Persist Security Info=True;'+

'User +''''+Dbname+''''+';'+

'Data Source='+''''+DBServerName+'''';

try

KeepConnection:=True;

Screen.Cursor:=crHourGlass;

Connected:=True;

Open;

Screen.Cursor:=crDefault;

ADOConnectLocalDB:=True;

except

ADOConnectLocalDB:=False;

end;

end;

end;

//Ado与ODBC共同连接数据库函数

function ADOODBCConnectLocalDB(Const Adocon:TAdoConnection;Const Dbname:String;ValidateMode:Integer):boolean;

begin

with Adocon do

begin

Close;

LoginPrompt:=False; //若数据库不存在时，进行判断。。。。。。

if ValidateMode=0 then//使用Windows NT验证模式

ConnectionString:='Provider=MSDASQL.1;'+

'Password="";'+

'Persist Security Info=False;'+

'User +''''+DBName+''''+';'+

'Initial Catalog='+''''+DBname+'''';

if ValidateMode=1 then//使用SQL SERVER验证模式

ConnectionString:='Provider=MSDASQL.1;'+

'Password="";'+

'Persist Security Info=True;'+

'User +''''+DBName+''''+';'+

'Initial Catalog='+''''+DBname+'''';

try

KeepConnection:=True;

Screen.Cursor:=crHourGlass;

Connected:=True;

Open;

Screen.Cursor:=crDefault;

ADOODBCConnectLocalDB:=True;

except

ADOODBCConnectLocalDB:=False;

end;

end;

end;

///在指定的数据库中建立表

function CreatTable(LpDataBaseName,LpTableName,LpSentence:string):Boolean;//建立新表

Var

CreatTableQuery:TQuery;

SQLsentence:string;

Successed:Boolean;//成功否

begin

Successed:=False;

SQLsentence:='CREATE TABLE "'+ LpTableName +'" ' + LpSentence;

CreatTableQuery:=TQuery.Create(nil);

try

try

with CreatTableQuery do

begin

UniDirectional:=True;

Active:=False;

Sql.Clear;

DataBaseName := LpDataBaseName; //数据库名

Sql.Add(SQLsentence);

ExecSQL;

Successed:=True;

end;

except

MessageBox(Application.Handle,Pchar(' 在建立数据库 '+Trim(LpDataBaseName)+' 中的 '+Trim(LpTableName)+' 表出错，建立未能成功 ！'),'建立失败',0+16);

Successed:=False;

end;

finally

CreatTableQuery.Free;//释放建立的Query

if Successed then

Result:=True//建立成功

else

Result:=False;//建立失败

end;

end;

//在指定的表中新填字段

function AddField(LpFieldName:string; LpDataType: TFieldType; LpSize: Word):string;//建立新表

var

Sentence,SQLsentence : string;

begin

Sentence:= '';

SQLsentence:='';

if LpFieldName = '' then

raise EDBUpdateErr.Create('字段名不能为空');

if Pos(' ', LpFieldName) <> 0 then

raise EDBUpdateErr.Create('字段名中不能含有空格字符');

if LpDataType = ftString then

sentence := 'ADD '+LpFieldName+' Char('+ IntToStr( LpSize ) + ')';

if LpDataType = ftInteger then

sentence := 'ADD '+LpFieldName+' Integer';

if LpDataType = ftSmallInt then

sentence := 'ADD '+LpFieldName+' SmallInt';

if LpDataType = ftFloat then

sentence := 'ADD '+LpFieldName+' Float('+ IntToStr( LpSize ) +',0)';

if LpDataType = ftDate then

sentence := 'ADD '+LpFieldName+' Date';

if LpDataType = ftTime then

sentence := 'ADD '+LpFieldName+' Time';

if LpDataType = ftDateTime then

sentence := 'ADD '+LpFieldName+' TimeStamp';

if sentence = '' then

raise EDBUpdateErr.Create('无效的字段类型');

if SQLSentence = '' then

SQLSentence := sentence

else

SQLSentence := SQLSentence + ', ' + sentence;

Result:=SQLSentence;//返回SQL句体

end;

//在指定的表中删除字段

function KillField(LpFieldName:string):String;//删除表中的字段

var

SQLsentence : string;

begin

if LpFieldName = '' then

raise EDBUpdateErr.Create('字段名不能为空');

if Pos(' ', LpFieldName) <> 0 then

raise EDBUpdateErr.Create('字段名中不能含有空格字符');

if SQLSentence = '' then

SQLSentence := 'DROP COLUMN ' + LpFieldName

else

SQLSentence := SQLSentence + ', DROP ' + LpFieldName;

Result:=SQLSentence;

end;

//修改表结构的SQL语句执行体

function AlterTableExec(LpDataBaseName,LpSentence:string):Boolean;//修改表结构

var

AlterQueryTable:TQuery;

Successed:Boolean;//成功否

begin

Successed:=False;

AlterQueryTable:= TQuery.Create(nil);

try

try

with AlterQueryTable do

begin

DataBaseName:=LpDataBaseName;//数据库名

UniDirectional:=True;

Active:=False;

Sql.Clear;

Sql.Add(LpSentence);

ExecSQL;

Successed:=True;

end;

except

Successed:=False;

end;

finally

AlterQueryTable.Free;

if successed then

Result:=True

else

Result:=False;

end;

end;

//修改、添加、删除表结构时的SQL句体

function GetSQLSentence(LpTableName,LpSQLsentence:string): string;

begin

Result := 'ALTER TABLE "'+ LpTableName +'" ' + LpSQLSentence + ';';

end;

//▎============================================================▎//

//▎======================⑾进制函数及过程======================▎//

//▎============================================================▎//

//字符转化成十六进制

function StrToHex(AStr: string): string;

var

I : Integer;

// Tmp: string;

begin

Result := '';

For I := 1 to Length(AStr) do

begin

Result := Result + Format('%2x', [Byte(AStr[I])]);

end;

I := Pos(' ', Result);

While I <> 0 do

begin

Result[I] := '0';

I := Pos(' ', Result);

end;

end;

//十六进制转化成字符

function HexToStr(AStr: string): string;

var

I : Integer;

CharValue: Word;

begin

Result := '';

for I := 1 to Trunc(Length(Astr)/2) do

begin

Result := Result + ' ';

CharValue := TransChar(AStr[2*I-1])*16 + TransChar(AStr[2*I]);

Result[I] := Char(CharValue);

end;

end;

function TransChar(AChar: Char): Integer;

begin

if AChar in ['0'..'9'] then

Result := Ord(AChar) - Ord('0')

else

Result := 10 + Ord(AChar) - Ord('A');

end;

//▎============================================================▎//

//▎=====================⑿其它函数及过程=======================▎//

//▎============================================================▎//

// 输出限制在Min..Max之间

function TrimInt(Value, Min, Max: Integer): Integer; overload;

begin

if Value > Max then

Result := Max

else if Value < Min then

Result := Min

else

Result := Value;

end;

// 输出限制在0..255之间

function IntToByte(Value: Integer): Byte; overload;

asm

OR EAX, EAX

JNS @@Positive

XOR EAX, EAX

RET

@@Positive:

CMP EAX, 255

JBE @@OK

MOV EAX, 255

@@OK:

end;

// 由TRect分离出坐标、宽高

procedure DeRect(Rect: TRect; var x, y, Width, Height: Integer);

begin

x := Rect.Left;

y := Rect.Top;

Width := Rect.Right - Rect.Left;

Height := Rect.Bottom - Rect.Top;

end;

// 比较两个Rect

function RectEqu(Rect1, Rect2: TRect): Boolean;

begin

Result := (Rect1.Left = Rect2.Left) and (Rect1.Top = Rect2.Top) and

(Rect1.Right = Rect2.Right) and (Rect1.Bottom = Rect2.Bottom);

end;

// 产生TSize类型

function EnSize(cx, cy: Integer): TSize;

begin

Result.cx := cx;

Result.cy := cy;

end;

// 计算Rect的宽度

function RectWidth(Rect: TRect): Integer;

begin

Result := Rect.Right - Rect.Left;

end;

// 计算Rect的高度

function RectHeight(Rect: TRect): Integer;

begin

Result := Rect.Bottom - Rect.Top;

end;

// 判断范围

function InBound(Value: Integer; Min, Max: Integer): Boolean;

begin

Result := (Value >= Min) and (Value <= Max);

end;

// 交换两个数

procedure CnSwap(var A, B: Byte); overload;

var

Tmp: Byte;

begin

Tmp := A;

A := B;

B := Tmp;

end;

procedure CnSwap(var A, B: Integer); overload;

var

Tmp: Integer;

begin

Tmp := A;

A := B;

B := Tmp;

end;

procedure CnSwap(var A, B: Single); overload;

var

Tmp: Single;

begin

Tmp := A;

A := B;

B := Tmp;

end;

procedure CnSwap(var A, B: Double); overload;

var

Tmp: Double;

begin

Tmp := A;

A := B;

B := Tmp;

end;

// 延时

procedure Delay(const uDelay: DWORD);

var

n: DWORD;

begin

n := GetTickCount;

while ((GetTickCount - n) <= uDelay) do

Application.ProcessMessages;

end;

// 在Win9X下让喇叭发声

procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1);

const

FREQ_SCALE = 93180;

var

Temp: WORD;

begin

Temp := FREQ_SCALE div Freq;

asm

in al,61h;

or al,3;

out 61h,al;

mov al,$b6;

out 43h,al;

mov ax,temp;

out 42h,al;

mov al,ah;

out 42h,al;

end;

Sleep(Delay);

asm

in al,;

and al,$fc;

out ,al;

end;

end;

// 显示Win32 Api运行结果信息

procedure ShowLastError;

var

ErrNo: Integer;

Buf: array[0..255] of Char;

begin

ErrNo := GetLastError;

FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrNo, 0, Buf, 255, nil);

if Buf = '' then StrCopy(@Buf, PChar(SUnknowError));

MessageBox(Application.Handle, PChar(string(Buf) + #10#13 +

SErrorCode + IntToStr(ErrNo)),

SCnInformation, MB_OK + MB_ICONINFORMATION);

end;

//将字体Font.Style写入INI文件

function writeFontStyle(FS: TFontStyles; inifile: string; write: boolean):string;

var

Mystyle : string;

Myini : Tinifile;

begin

Mystyle := '[';

if fsBold in FS then MyStyle := MyStyle + 'fsBold';

if fsItalic in FS then

if MyStyle = '[' then

MyStyle := MyStyle + 'fsItalic'

else

MyStyle := MyStyle + ',fsItalic';

if fsUnderline in FS then

if MyStyle = '[' then

MyStyle := MyStyle + 'fsUnderline'

else

MyStyle := MyStyle + ',fsUnderline';

if fsStrikeOut in FS then

if MyStyle = '[' then

MyStyle := MyStyle + 'fsStrikeOut'

else

MyStyle := MyStyle + ',fsStrikeOut';

MyStyle := MyStyle + ']';

if write then

begin

Myini := TInifile.Create(inifile);

Myini.WriteString('FontStyle', 'style', MyStyle);

Myini.free;

end;

Result := MyStyle;

end;

//从INI文件中读取字体Font.Style文件

function readFontStyle(inifile: string): TFontStyles;

var

MyFontStyle : TFontStyles;

MyStyle : string;

Myini : Tinifile;

begin

MyFontStyle := [];

Myini := TInifile.Create(inifile);

Mystyle := Myini.ReadString('Fontstyle', 'style', '[]');

if pos('fsBold', Mystyle) > 0 then MyFontStyle := MyFontStyle + [fsBold];

if Pos('fsItalic', MyStyle) > 0 then MyFontStyle := MyFontStyle + [fsItalic];

if Pos('fsUnderline', MyStyle) > 0 then

MyFontStyle := MyFontStyle + [fsUnderline];

if Pos('fsStrikeOut', MyStyle) > 0 then

MyFontStyle := MyFontStyle + [fsStrikeOut];

MyIni.free;

Result := MyFontStyle;

end;

//*取得TMemo 控件当前光标的行和列信息到Tpoint中

//function ReadCursorPos(SourceMemo: TMemo): TPoint;

function ReadCursorPos(SourceMemo: TMemo): string;

var

// Point: TPoint;

X,Y:integer;

begin

// point.y := SendMessage(SourceMemo.Handle, EM_LINEFROMCHAR,SourceMemo.SelStart,0);

// point.x := SourceMemo.SelStart- SendMessage(SourceMemo.Handle,EM_LINEINDEX,point.y,0);

y := SendMessage(SourceMemo.Handle, EM_LINEFROMCHAR,SourceMemo.SelStart,0);

x := SourceMemo.SelStart- SendMessage(SourceMemo.Handle,EM_LINEINDEX,y,0);

Result := '行:'+inttostr(y+1)+' '+'列:'+inttostr(x+1);

end;

//*检查Tmemo控件能否Undo功能

function CanUndo(AMemo: TMemo): Boolean;

begin

Result :=AMemo.Perform(EM_CANUNDO, 0, 0)<>0;

end;

//* 实现Undo功能

procedure Undo(Amemo: Tmemo);

begin

Amemo.Perform(EM_UNDO, 0, 0);

end;

//* 实现ComBoBox自动下拉

procedure AutoListDisplay(ACombox:TComboBox);

begin

SendMessage(ACombox.handle, CB_SHOWDROPDOWN, Integer(True), 0);

end;

//* 小写金额转换为大写

function UpperMoney(small:real):string;

var

SmallMonth,BigMonth:string;

wei1,qianwei1:string[2];

qianwei,dianweizhi,qian:integer;

ObjSmall:real;

begin

{------- 修改参数令值更精确 -------}

ObjSmall:=Abs(small);

qianwei:=-2;

Smallmonth:=formatfloat('0.00',ObjSmall);

dianweizhi :=pos('.',Smallmonth);

for qian:=length(Smallmonth) downto 1 do

begin

if qian<>dianweizhi then

begin

case strtoint(copy(Smallmonth,qian,1)) of

1:wei1:='壹';

2:wei1:='贰';

3:wei1:='叁';

4:wei1:='肆';

5:wei1:='伍';

6:wei1:='陆';

7:wei1:='柒';

8:wei1:='捌';

9:wei1:='玖';

0:wei1:='零';

end;

case qianwei of

-3:qianwei1:='厘';

-2:qianwei1:='分';

-1:qianwei1:='角';

0 :qianwei1:='元';

1 :qianwei1:='拾';

2 :qianwei1:='佰';

3 :qianwei1:='千';

4 :qianwei1:='万';

5 :qianwei1:='拾';

6 :qianwei1:='佰';

7 :qianwei1:='千';

8 :qianwei1:='亿';

9 :qianwei1:='十';

10:qianwei1:='佰';

11:qianwei1:='千';

end;

inc(qianwei);

if Small<0 then

BigMonth :='负'+wei1+qianwei1+BigMonth

else

BigMonth :=wei1+qianwei1+BigMonth

end;

end;

Result:=BigMonth;

end;

//利用系统时间产生随机数

function Myrandom(Num: Integer): integer;

var

T: _SystemTime;

X: integer;

I: integer;

begin

Result := 0;

If Num = 0 then Exit;;

GetSystemTime(T);

X := Trunc(T.wMilliseconds/10) * T.wSecond * 1231;

X := X + random(1);

if X<>0 then

X := -X;

X := Random(X);

X := X mod num;

for I := 0 to X do

X := Random(Num);

Result := X;

end;

//打开输入法

procedure OpenIME(ImeName: string);

var

i: integer;

MyHKL: hkl;

begin

if ImeName <> '' then begin

if Screen.Imes.Count <> 0 then begin

i := Screen.Imes.IndexOf(ImeName);

if i >= 0 then MyHKL := hkl(Screen.Imes.Objects[i]);

ActivateKeyboardLayout(MyHKL, KLF_ACTIVATE);

end;

end;

end;

//关闭输入法

procedure CloseIME;

var

MyHKL: hkl;

begin

MyHKL := GetKeyboardLayout(0);

if ImmIsIme(MyHKL) then

ImmSimulateHotKey(Application.Handle, IME_CHOTKEY_IME_NONIME_TOGGLE);

end;

//打开中文输入法

procedure ToChinese(hWindows: THandle; bChinese: boolean);

begin

if ImmIsIME(GetKeyboardLayOut(0)) <> bChinese then

ImmSimulateHotKey(hWindows, IME_THotKey_IME_NonIME_Toggle);

end;

//数据备份

procedure BackUpData(LpBackDispMessTitle:String);

var

i,j:integer;

Source,Dest:array[0..200]of char;

s1:string;

Lp:_SHFILEOPSTRUCTA;

Success:Integer;

begin

if MessageBox(Application.Handle,' 您确认要备份数据吗？','询问窗口',4+32+256)=6 then

begin

with LP do

begin

Lp.wnd:=Application.Handle;

wFunc:=FO_COPY;

s1:='DATA\*.*';

i:=Length(s1);

StrCopy(Source,PChar(s1));

Source[i]:=#0;

Source[i+1]:=#0;

Source[i+2]:=#0;

pFrom:=Source;

s1:='BACKUP';

j:=Length(s1);

StrCopy(Dest,PChar(s1));

Dest[j]:='\';

Dest[j+1]:=#0;

Dest[j+2]:=#0;

Dest[j+3]:=#0;

pTo:=Dest;

fFlags:=FOF_ALLOWUNDO;

fAnyOperationsAborted:=False;

lpszProgressTitle:=PChar(LpBackDispMessTitle);

end;

Success:=SHFileOperation(LP);

case Success of

0:

MessageBox(Application.Handle,' 所有数据已备份完成 ！','提示窗口',0+48);

117:

MessageBox(Application.Handle,Pchar(' 您未创建“'+ExtractFilePath(Application.ExeName)+'BACKUP”目录所以不能完成数据备份 ！'),'提示窗口',0+16)

else

MessageBox(Application.Handle,' 在备份数据的过程中被用户中途中断 ！','提示窗口',0+16);

end;

end;

end;

////////////////////////////////////////////////////////////////////////////////

// //

// 从文件中读取Ado连接字串 //

// //

////////////////////////////////////////////////////////////////////////////////

function GetConnectionString(DataBaseName:string):string;

var FileStringList:Tstringlist;

TempString: ansistring;

TheReg:TRegistry;KeyName,fAppPath:string;

i:Integer;

begin

TheReg:=TRegistry.Create;

try

TheReg.RootKey:=HKEY_LOCAL_MACHINE;

KeyName:='Software\政府采购管理系统';

if TheReg.OpenKey(KeyName,False) then

fAppPath:=TheReg.ReadString('ApplicationPath');

finally

TheReg.Free;

end;

FileStringList:=Tstringlist.Create;

//先判断connection.txt是否存在,存在就调入

if FileExists(fAppPath+'\connection.txt') then

FileStringList.LoadFromFile(fAppPath+'\connection.txt')

else

begin

application.MessageBox('在系统所在目录中没有检测到连接文件(connection.txt)，无法启动系统。','提示',MB_IconError+mb_ok);

Result:='';

FileStringList.Free;

Exit;

end;

//组成一个符串，好进行处理。

TempString:='';

for i:=0 to FileStringList.Count-1 do

begin

TempString:=TempString+FileStringList.strings[i];

end;

TempString:=Replace(TempString,'DataBaseName',DataBaseName,False);

Result:=TempString;

end;

{function GetRemoteServerName：返回远程服务器的机器名称}

function GetRemoteServerName:string;

var iniServer:TIniFile;

TheReg:TRegistry;KeyName,fAppPath,RServerName:string;

begin

TheReg:=TRegistry.Create;

try

TheReg.RootKey:=HKEY_LOCAL_MACHINE;

KeyName:='Software\政府采购管理系统';

if TheReg.OpenKey(KeyName,False) then

fAppPath:=TheReg.ReadString('ApplicationPath');

finally

TheReg.Free;

end;

try

iniServer:=TIniFile.Create(fAppPath+'\RemoteServerName.ini');

with iniServer do

RServerName:=ReadString('Option','RServerName','');

iniServer.Free;

except

raise exception.Create('致命错误：未找到包含Com服务器配置的信息文件，初始化失败。');

end;

Result:=RServerName;

end;

initialization

WndLong := GetWindowLong(Application.Handle, GWL_EXSTYLE);

end.

{▎ 觉得还一般 请关注 http://www.cdsunco.com/down.htm 还有更多的好东西 ▎}