137 lines
4.0 KiB
ObjectPascal
137 lines
4.0 KiB
ObjectPascal
unit U_DataLink;
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes, DB, ADODB, ImgList, Controls, cxStyles, cxLookAndFeels,
|
|
Windows, Messages, forms, OleCtnrs, DateUtils, ExtCtrls, SyncObjs, cxClasses,
|
|
dxSkinsCore, dxSkinsDefaultPainters, dxSkinBlack, dxSkinBlue,
|
|
dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee, dxSkinDarkRoom,
|
|
dxSkinDarkSide, dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle,
|
|
dxSkinFoggy, dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary,
|
|
dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin,
|
|
dxSkinMetropolis, dxSkinMetropolisDark, dxSkinMoneyTwins,
|
|
dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
|
|
dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black,
|
|
dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinOffice2013DarkGray,
|
|
dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinPumpkin,
|
|
dxSkinSeven, dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus,
|
|
dxSkinSilver, dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008,
|
|
dxSkinTheAsphaltWorld, dxSkinValentine, dxSkinVS2010, dxSkinWhiteprint,
|
|
dxSkinXmas2008Blue;
|
|
|
|
type
|
|
TMyThread = class(TThread)
|
|
protected
|
|
procedure Execute; override;
|
|
end;
|
|
|
|
var
|
|
DConString: string; {全局连接字符串}
|
|
server, dtbase, user, pswd: string; {数据库连接参数}
|
|
DCurHandle: hwnd; //当前窗体句柄
|
|
DName: string; //#用户名#//
|
|
DCode: string; //#用户编号#//
|
|
Ddatabase: string; //#数据库名称#//
|
|
UserDataFlag: string;
|
|
DTitCaption: string; //#主窗体名称#//
|
|
DParameters1, DParameters2, DParameters3, DParameters4, DParameters5: string; // 外部参数；
|
|
DParameters6, DParameters7, DParameters8, DParameters9, DParameters10: string; //外部参数；
|
|
OldDllApp: Tapplication; //保存原有句柄
|
|
NewDllApp: Tapplication; //当前句柄
|
|
MainApplication: Tapplication;
|
|
DFormCode: integer; //当前窗口号
|
|
IsDelphiLanguage: integer;
|
|
DServerDate: TdateTime; //服务器时间
|
|
DCompany: string; //公司
|
|
PicSvr: string;
|
|
type
|
|
TDataLink_ShuttleSchedule = class(TDataModule)
|
|
AdoDataLink: TADOQuery;
|
|
ADOLink: TADOConnection;
|
|
ThreeImgList: TImageList;
|
|
ThreeLookAndFeelCol: TcxLookAndFeelController;
|
|
ThreeColorBase: TcxStyleRepository;
|
|
SHuangSe: TcxStyle;
|
|
SkyBlue: TcxStyle;
|
|
Default: TcxStyle;
|
|
QHuangSe: TcxStyle;
|
|
Red: TcxStyle;
|
|
FontBlue: TcxStyle;
|
|
TextSHuangSe: TcxStyle;
|
|
FonePurple: TcxStyle;
|
|
FoneClMaroon: TcxStyle;
|
|
FoneRed: TcxStyle;
|
|
RowColor: TcxStyle;
|
|
handBlack: TcxStyle;
|
|
cxBlue: TcxStyle;
|
|
SHuangSeCu: TcxStyle;
|
|
Timer_link: TTimer;
|
|
procedure DataModuleDestroy(Sender: TObject);
|
|
procedure Timer_linkTimer(Sender: TObject);
|
|
procedure DataModuleCreate(Sender: TObject);
|
|
private
|
|
{ Private declarations }
|
|
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
TMakebar = procedure(ucData: pchar; nDataLen: integer; nErrLevel: integer; nMask: integer; nBarEdition: integer; szBmpFileName: pchar; nScale: integer); stdcall;
|
|
|
|
TMixtext = procedure(szSrcBmpFileName: PChar; szDstBmpFileName: PChar; sztext: PChar; fontsize, txtheight, hmargin, vmargin, txtcntoneline: integer); stdcall;
|
|
|
|
var
|
|
DataLink_ShuttleSchedule: TDataLink_ShuttleSchedule;
|
|
CriticalSection: TCriticalSection; {声明临界}
|
|
|
|
implementation
|
|
{$R *.dfm}
|
|
|
|
procedure TMyThread.Execute;
|
|
begin
|
|
FreeOnTerminate := True;
|
|
CriticalSection.Enter;
|
|
try
|
|
with DataLink_ShuttleSchedule.AdoDataLink do
|
|
begin
|
|
close;
|
|
sql.Clear;
|
|
sql.Add('select getdate()');
|
|
open;
|
|
end;
|
|
except
|
|
try
|
|
with DataLink_ShuttleSchedule.ADOLink do
|
|
begin
|
|
Connected := false;
|
|
ConnectionString := DConString;
|
|
LoginPrompt := false;
|
|
Connected := true;
|
|
end;
|
|
except
|
|
|
|
end;
|
|
end;
|
|
CriticalSection.Leave;
|
|
end;
|
|
|
|
procedure TDataLink_ShuttleSchedule.DataModuleDestroy(Sender: TObject);
|
|
begin
|
|
CriticalSection.Free;
|
|
DataLink_ShuttleSchedule := nil;
|
|
end;
|
|
|
|
procedure TDataLink_ShuttleSchedule.Timer_linkTimer(Sender: TObject);
|
|
begin
|
|
TMyThread.Create(False);
|
|
end;
|
|
|
|
procedure TDataLink_ShuttleSchedule.DataModuleCreate(Sender: TObject);
|
|
begin
|
|
CriticalSection := TCriticalSection.Create;
|
|
end;
|
|
|
|
end.
|
|
|