unit U_DataLink; interface uses SysUtils, Classes, DB, ADODB, ImgList, Controls, cxStyles, cxLookAndFeels, Windows, Messages, forms, OleCtnrs, DateUtils, ExtCtrls, SyncObjs, cxClasses, dxSkinsCore, dxSkinsDefaultPainters, System.ImageList, U_BaseDataLink, cxImageList, cxGraphics, cxEdit, cxContainer, dxSkinsForm, cxLocalization, dxSkinBasic, 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, dxSkinOffice2016Colorful, dxSkinOffice2016Dark, dxSkinOffice2019Black, dxSkinOffice2019Colorful, dxSkinOffice2019DarkGray, dxSkinOffice2019White, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringtime, dxSkinStardust, dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinTheBezier, dxSkinValentine, dxSkinVisualStudio2013Blue, dxSkinVisualStudio2013Dark, dxSkinVisualStudio2013Light, dxSkinVS2010, dxSkinWhiteprint, dxSkinWXI, dxSkinXmas2008Blue, dxCore, dxLayoutLookAndFeels; 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; //#数据库名称#// DTitCaption: string; //#主窗体名称#// PicSvr: string; fDllFileName: 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; //公司 IpCall: Integer; IpWLDZStr: string; UserDataFlag: string; type TDataLink_Contract = class(TBaseDataLink) AdoDataLink: TADOQuery; ADOLink: TADOConnection; ThreeImgList: TImageList; Timer_link: TTimer; ImageList_new32: TImageList; 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_Contract: TDataLink_Contract; CriticalSection: TCriticalSection; {声明临界} implementation {$R *.dfm} procedure TMyThread.Execute; begin FreeOnTerminate := True; CriticalSection.Enter; try with DataLink_Contract.AdoDataLink do begin close; sql.Clear; sql.Add('select getdate()'); open; end; except try with DataLink_Contract.ADOLink do begin Connected := false; ConnectionString := DConString; LoginPrompt := false; Connected := true; end; except end; end; CriticalSection.Leave; end; procedure TDataLink_Contract.DataModuleDestroy(Sender: TObject); begin inherited; CriticalSection.Free; DataLink_Contract := nil; end; procedure TDataLink_Contract.Timer_linkTimer(Sender: TObject); begin TMyThread.Create(False); end; procedure TDataLink_Contract.DataModuleCreate(Sender: TObject); begin inherited; CriticalSection := TCriticalSection.Create; end; end.