⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 sqlqry.pas

📁 仿sql查询分析器
💻 PAS
📖 第 1 页 / 共 3 页
字号:
🔍
123 
unit SqlQry;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, ADOInt, Pub, ActiveX, OleDb, Menus;

type
  TSqlQryFrm = class(TForm)
    Pgc1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Splitter1: TSplitter;
    MoSql: TMemo;
    SbxResult: TScrollBox;
    MoMsg: TMemo;
    SBar: TStatusBar;
    PnlMain: TPanel;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    PnlResult: TPanel;
    GridMenu: TPopupMenu;
    MnCopyGridText: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PnlMainResize(Sender: TObject);
    procedure Splitter1Moved(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure MnCopyGridTextClick(Sender: TObject);
  private
    FConnection: _Connection;

//    FUserName: string;
//    FServer: string;
//    FPassword: string;
//    FAuthType: TAuthType;
    FDatabase: string;

    FFileName: string;        // 当前打开的文件

    FExecuting: Boolean;      // 当前是否在执行SQL?
    FExecThread: TThread;     // 执行的线程.
    FParseOnly: Boolean;      // 仅分析, 不执行.
    FCanceling: Boolean;      // 取消按钮已经按下.
    FConnClosed: Boolean;     // 连接已经中断
    
    FServerName: string;
    FSUserName: string;

    FPnlRate: Double;

    function ExecuteSql(const ASql: WideString): Integer;
    function ExecuteRst(const ASql: WideString): _Recordset;

    procedure ClearResults;
    procedure SetDatabase(const Value: string);
    procedure UpdateTitle;
    procedure UpdateDatabase;

    procedure ProcessResults;
    procedure AddMsg(Msg: string);
    procedure AddMsgs(MsgList: TStringList);
    procedure AddRecordsets(DataList: TList);
    procedure ClearVarRef;

    procedure OnThreadTerminate(Sender: TObject);
    procedure OnGridResize(Sender: TObject);

    function GetResultBoxVisible: Boolean;
    function GetConnectionString: string;
  public
//    property Server: string read FServer write FServer;
//    property UserName: string read FUserName write FUserName;
//    property Password: string read FPassword write FPassword;
//    property AuthType: TAuthType read FAuthType write FAuthType;
    property Database: string read FDatabase write SetDatabase;
    property ConnectionString: string read GetConnectionString;

    property ServerName: string read FServerName;
    property SUserName: string read FSUserName;

    // True:当前正在执行SQL
    property Executing: Boolean read FExecuting;

    procedure LoadFile;
    function SaveFile: Boolean;
    function SaveAs: Boolean;

    procedure Initialize(Conn: _Connection);

    procedure Execute;
    procedure ParseSQL;
    procedure CancelExecute;

    procedure ToggleResultBox;
    property ResultBoxVisible: Boolean read GetResultBoxVisible;

    function GetDatabaseList: TStringList;
  end;

var
  SqlQryFrm: TSqlQryFrm;

implementation

uses DataGrid, RowData, Clipbrd, ComObj;

{$R *.dfm}

type
// ADO stdcall interface
  ADOStd = interface;
  ConnectionStd15 = interface;
  CommandStd15 = interface;
  CommandStd = interface;
  RecordsetStd15 = interface;
  RecordsetStd = interface;

  ADOStd = interface(IDispatch)
    ['{00000534-0000-0010-8000-00AA006D2EA4}']
    function Get_Properties(out ppvObject: Properties): HResult; stdcall;
  end;

  ConnectionStd15 = interface(_ADO)
    ['{00000515-0000-0010-8000-00AA006D2EA4}']
    function Get_ConnectionString(out pbstr: WideString): HResult; stdcall;
    function Set_ConnectionString(const pbstr: WideString): HResult; stdcall;
    function Get_CommandTimeout(out plTimeout: Integer): HResult; stdcall;
    function Set_CommandTimeout(plTimeout: Integer): HResult; stdcall;
    function Get_ConnectionTimeout(out plTimeout: Integer): HResult; stdcall;
    function Set_ConnectionTimeout(plTimeout: Integer): HResult; stdcall;
    function Get_Version(out pbstr: WideString): HResult; stdcall;
    function Close: HResult; stdcall;
    function Execute(const CommandText: WideString; out RecordsAffected: OleVariant; 
                     Options: Integer; out ppiRset: _Recordset): HResult; stdcall;
    function BeginTrans(out TransactionLevel: Integer): HResult; stdcall;
    function CommitTrans: HResult; stdcall;
    function RollbackTrans: HResult; stdcall;
    function Open(const ConnectionString: WideString; const UserID: WideString; 
                  const Password: WideString; Options: Integer): HResult; stdcall;
    function Get_Errors(out ppvObject: Errors): HResult; stdcall;
    function Get_DefaultDatabase(out pbstr: WideString): HResult; stdcall;
    function Set_DefaultDatabase(const pbstr: WideString): HResult; stdcall;
    function Get_IsolationLevel(out Level: IsolationLevelEnum): HResult; stdcall;
    function Set_IsolationLevel(Level: IsolationLevelEnum): HResult; stdcall;
    function Get_Attributes(out plAttr: Integer): HResult; stdcall;
    function Set_Attributes(plAttr: Integer): HResult; stdcall;
    function Get_CursorLocation(out plCursorLoc: CursorLocationEnum): HResult; stdcall;
    function Set_CursorLocation(plCursorLoc: CursorLocationEnum): HResult; stdcall;
    function Get_Mode(out plMode: ConnectModeEnum): HResult; stdcall;
    function Set_Mode(plMode: ConnectModeEnum): HResult; stdcall;
    function Get_Provider(out pbstr: WideString): HResult; stdcall;
    function Set_Provider(const pbstr: WideString): HResult; stdcall;
    function Get_State(out plObjState: Integer): HResult; stdcall;
    function OpenSchema(Schema: SchemaEnum; Restrictions: OleVariant; SchemaID: OleVariant; 
                        out pprset: _Recordset): HResult; stdcall;
  end;

  ConnectionStd = interface(ConnectionStd15)
    ['{00000550-0000-0010-8000-00AA006D2EA4}']
    function Cancel: HResult; stdcall;
  end;

  CommandStd15 = interface(ADOStd)
    ['{00000508-0000-0010-8000-00AA006D2EA4}']
    function Get_ActiveConnection(out ppvObject: _Connection): HResult; stdcall;
    function _Set_ActiveConnection(const ppvObject: _Connection): HResult; stdcall;
    function Set_ActiveConnection(ppvObject: OleVariant): HResult; stdcall;
    function Get_CommandText(out pbstr: WideString): HResult; stdcall;
    function Set_CommandText(const pbstr: WideString): HResult; stdcall;
    function Get_CommandTimeout(out pl: Integer): HResult; stdcall;
    function Set_CommandTimeout(pl: Integer): HResult; stdcall;
    function Get_Prepared(out pfPrepared: WordBool): HResult; stdcall;
    function Set_Prepared(pfPrepared: WordBool): HResult; stdcall;
    function Execute(out RecordsAffected: OleVariant; var Parameters: OleVariant; Options: Integer; 
                     out ppiRs: _Recordset): HResult; stdcall;
    function CreateParameter(const Name: WideString; Type_: DataTypeEnum; 
                             Direction: ParameterDirectionEnum; Size: Integer; Value: OleVariant; 
                             out ppiprm: _Parameter): HResult; stdcall;
    function Get_Parameters(out ppvObject: Parameters): HResult; stdcall;
    function Set_CommandType(plCmdType: CommandTypeEnum): HResult; stdcall;
    function Get_CommandType(out plCmdType: CommandTypeEnum): HResult; stdcall;
    function Get_Name(out pbstrName: WideString): HResult; stdcall;
    function Set_Name(const pbstrName: WideString): HResult; stdcall;
  end;

  CommandStd = interface(CommandStd15)
    ['{0000054E-0000-0010-8000-00AA006D2EA4}']
    function Get_State(out plObjState: Integer): HResult; stdcall;
    function Cancel: HResult; stdcall;
  end;

  RecordsetStd15 = interface(ADOStd)
    ['{0000050E-0000-0010-8000-00AA006D2EA4}']
    function Get_AbsolutePosition(out pl: PositionEnum): HResult; stdcall;
    function Set_AbsolutePosition(pl: PositionEnum): HResult; stdcall;
    function _Set_ActiveConnection(const pvar: IDispatch): HResult; stdcall;
    function Set_ActiveConnection(pvar: OleVariant): HResult; stdcall;
    function Get_ActiveConnection(out pvar: OleVariant): HResult; stdcall;
    function Get_BOF(out pb: WordBool): HResult; stdcall;
    function Get_Bookmark(out pvBookmark: OleVariant): HResult; stdcall;
    function Set_Bookmark(pvBookmark: OleVariant): HResult; stdcall;
    function Get_CacheSize(out pl: Integer): HResult; stdcall;
    function Set_CacheSize(pl: Integer): HResult; stdcall;
    function Get_CursorType(out plCursorType: CursorTypeEnum): HResult; stdcall;
    function Set_CursorType(plCursorType: CursorTypeEnum): HResult; stdcall;
    function Get_EOF(out pb: WordBool): HResult; stdcall;
    function Get_Fields(out ppvObject: Fields): HResult; stdcall;
    function Get_LockType(out plLockType: LockTypeEnum): HResult; stdcall;
    function Set_LockType(plLockType: LockTypeEnum): HResult; stdcall;
    function Get_MaxRecords(out plMaxRecords: Integer): HResult; stdcall;
    function Set_MaxRecords(plMaxRecords: Integer): HResult; stdcall;
    function Get_RecordCount(out pl: Integer): HResult; stdcall;
    function _Set_Source(const pvSource: IDispatch): HResult; stdcall;
    function Set_Source(const pvSource: WideString): HResult; stdcall;
    function Get_Source(out pvSource: OleVariant): HResult; stdcall;
    function AddNew(FieldList: OleVariant; Values: OleVariant): HResult; stdcall;
    function CancelUpdate: HResult; stdcall;
    function Close: HResult; stdcall;
    function Delete(AffectRecords: AffectEnum): HResult; stdcall;
    function GetRows(Rows: Integer; Start: OleVariant; Fields: OleVariant; out pvar: OleVariant): HResult; stdcall;
    function Move(NumRecords: Integer; Start: OleVariant): HResult; stdcall;
    function MoveNext: HResult; stdcall;
    function MovePrevious: HResult; stdcall;
    function MoveFirst: HResult; stdcall;
    function MoveLast: HResult; stdcall;
    function Open(Source: OleVariant; ActiveConnection: OleVariant; CursorType: CursorTypeEnum; 
                  LockType: LockTypeEnum; Options: Integer): HResult; stdcall;
    function Requery(Options: Integer): HResult; stdcall;
    function _xResync(AffectRecords: AffectEnum): HResult; stdcall;
    function Update(Fields: OleVariant; Values: OleVariant): HResult; stdcall;
    function Get_AbsolutePage(out pl: PositionEnum): HResult; stdcall;
    function Set_AbsolutePage(pl: PositionEnum): HResult; stdcall;
    function Get_EditMode(out pl: EditModeEnum): HResult; stdcall;
    function Get_Filter(out Criteria: OleVariant): HResult; stdcall;
    function Set_Filter(Criteria: OleVariant): HResult; stdcall;
    function Get_PageCount(out pl: Integer): HResult; stdcall;
    function Get_PageSize(out pl: Integer): HResult; stdcall;
    function Set_PageSize(pl: Integer): HResult; stdcall;
    function Get_Sort(out Criteria: WideString): HResult; stdcall;
    function Set_Sort(const Criteria: WideString): HResult; stdcall;
    function Get_Status(out pl: Integer): HResult; stdcall;
    function Get_State(out plObjState: Integer): HResult; stdcall;
    function _xClone(out ppvObject: _Recordset): HResult; stdcall;
    function UpdateBatch(AffectRecords: AffectEnum): HResult; stdcall;
    function CancelBatch(AffectRecords: AffectEnum): HResult; stdcall;
    function Get_CursorLocation(out plCursorLoc: CursorLocationEnum): HResult; stdcall;
    function Set_CursorLocation(plCursorLoc: CursorLocationEnum): HResult; stdcall;
    function NextRecordset(out RecordsAffected: OleVariant; out ppiRs: _Recordset): HResult; stdcall;
    function Supports(CursorOptions: CursorOptionEnum; out pb: WordBool): HResult; stdcall;
    function Get_Collect(Index: OleVariant; out pvar: OleVariant): HResult; stdcall;
    function Set_Collect(Index: OleVariant; pvar: OleVariant): HResult; stdcall;
    function Get_MarshalOptions(out peMarshal: MarshalOptionsEnum): HResult; stdcall;
    function Set_MarshalOptions(peMarshal: MarshalOptionsEnum): HResult; stdcall;
    function Find(const Criteria: WideString; SkipRecords: Integer; 
                  SearchDirection: SearchDirectionEnum; Start: OleVariant): HResult; stdcall;
  end;

  RecordsetStd = interface(RecordsetStd15)
    ['{0000054F-0000-0010-8000-00AA006D2EA4}']
    function Cancel: HResult; stdcall;
    function Get_DataSource(out ppunkDataSource: IUnknown): HResult; stdcall;
    function _Set_DataSource(const ppunkDataSource: IUnknown): HResult; stdcall;
    function Save(const FileName: WideString; PersistFormat: PersistFormatEnum): HResult; stdcall;
    function Get_ActiveCommand(out ppCmd: IDispatch): HResult; stdcall;
    function Set_StayInSync(pbStayInSync: WordBool): HResult; stdcall;
    function Get_StayInSync(out pbStayInSync: WordBool): HResult; stdcall;
    function GetString(StringFormat: StringFormatEnum; NumRows: Integer; 
                       const ColumnDelimeter: WideString; const RowDelimeter: WideString; 
                       const NullExpr: WideString; out pRetString: WideString): HResult; stdcall;
    function Get_DataMember(out pbstrDataMember: WideString): HResult; stdcall;
    function Set_DataMember(const pbstrDataMember: WideString): HResult; stdcall;
    function CompareBookmarks(Bookmark1: OleVariant; Bookmark2: OleVariant; 
                              out pCompare: CompareEnum): HResult; stdcall;
    function Clone(LockType: LockTypeEnum; out ppvObject: RecordsetStd): HResult; stdcall;
    function Resync(AffectRecords: AffectEnum; ResyncValues: ResyncEnum): HResult; stdcall;
  end;

// SQLServer Error Info for OleDB extendsion
  PSSERRORINFO = ^SSERRORINFO;
  SSERRORINFO = record
    pwszMessage: PWideChar;
    pwszServer: PWideChar;
    pwszProcedure: PWideChar;
    lNative: LongInt;
    bState: Byte;
    bClass: Byte;
    wLineNumber: Word;
  end;

  ISQLServerErrorInfo = interface
  ['{5CF4CA12-EF21-11d0-97E7-00C04FC2AD98}']
    function GetErrorInfo( var ppErrorInfo: PSSERRORINFO;
                          var ppStringsBuffer: Pointer): HResult; stdcall;
  end;

// OleDB interface
  IErrorRecords = interface
  ['{0c733a67-2a1c-11ce-ade5-00aa0044773d}']
    function AddErrorRecord(
                    const pErrorInfo: TErrorInfo;
                    dwLookupID: LongWord;
                    const pdispparams: TDispParams;
                    pUnkCustomError: IUnknown;
                    dwDynamicErrorID: LongWord
                  ): HResult; stdcall;
    function GetBasicErrorInfo(
                    ulRecordNum: LongWord;
                    out pErrorInfo: TErrorInfo
                  ): HResult; stdcall;
    function GetCustomErrorObject(
                    ulRecordNum: LongWord;
                    const riid: TGuid;
                    out ppObject: IUnknown
                  ): HResult; stdcall;
    function GetErrorInfo(
                    ulRecordNum: LongWord;
                    lcid: LCID;
                    out ppErrorInfo: IErrorInfo
                  ): HResult; stdcall;
    function GetErrorParameters(
                    ulRecordNum: LongWord;
                    out pdispparams: TDispParams
                  ): HResult; stdcall;
    function GetRecordCount(var pcRecords: Integer): HResult; stdcall;
  end;

type
  TStringDynArray = array of string;

function SplitSQL(const sql: string): TStringDynArray;
var
  list: TStringList;
  I, J: Integer;
  sqls: TStringDynArray;

  procedure AddSql(L1, L2: Integer);
  var
    OldLen, II: Integer;
    s: string;
  begin            
    for II := L1 to L2 do
      s := s + list[II] + #13#10;
    if Trim(s) <> '' then
    begin
      OldLen := Length(sqls);
      SetLength(sqls, OldLen + 1);
      sqls[OldLen] := s;
    end;
  end;
begin
  SetLength(sqls, 0);

  // 分解SQL语句, 两个'GO'之间的语句为一个执行单位
  list := TStringList.Create;
  try
    list.Text := sql;
    I := 0;
    J := 0;
    while I < list.Count do
    begin
      if SameText(Trim(list[I]), 'GO') then
      begin
        AddSql(J, I - 1);
        J := I + 1;
      end;
      Inc(I);
    end;
    AddSql(J, I - 1);
  finally
    list.Free;
  end;
  Result := sqls;
end;

// 处理OLE DB错误.
// Msg: 错误信息字符串
// 返回值: 0 无错误
//         1 一般错误
//         2 消息性错误
//         3 连接断开
function ProcessResult(var ErrorMsg: string): Integer;
var
  OleErr: IErrorInfo;
  ErrRecords: IErrorRecords;
  SSqlErr: ISQLServerErrorInfo;
  I, RecCnt: Integer;
  hr: HResult;
  InfoMsg, ConnClosed: Boolean;

  // 取得出错信息.
  // 返回 TRUE: 成功通过ErrInfo取得出错信息, ErrMsg为出错信息的字符串.
  //    FALSE: 失败.
  function GetSSqlErrInfo(ErrInfo: ISQLServerErrorInfo; var ErrMsg: string): Boolean;
  var
    SSErrInfo: PSSERRORINFO;
    pStrBuf: Pointer;
    ProcName: String;
  begin
    Result := False;
    if ErrInfo.GetErrorInfo(SSErrInfo, pStrBuf) = S_OK then
    begin
      // 即使GetErrorInfo返回S_OK, SSErrInfo也可能为nil
      if SSErrInfo = nil then Exit;
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -