ccreatedb.pas

控件作用: 自动创建SQL数据库(可以同时间创建多个数据库) 控件用法: 1:添加数据库(可以添加多个数据库)选择相应的数据库. 2:添加SQL文件(创建数据表,视图,过程.可从SQL文件中

    for i := 0 to FADOQ.SQL.Count - 1 do
      Writeln(f, FADOQ.SQL[i]);
    CloseFile(f);
    PostMessage(FParent.Handle, cErrorMsg, 0, 0);
    Terminate;
  end;
end;

{ TcCreateDBV2 }

procedure TcCreateDBV2.Cancel;
begin
  //if FCancel then
  //else begin
  if FState = cDoing then begin
    FCancel := true;
    FState := cCanceling;
    //While Not (FState in [cCanceled, cFinish, cErrored]) do
    //  Application.ProcessMessages;
  end;
end;

procedure TcCreateDBV2.CancelMsg(var aMsg: TMessage);
begin
  FState := cCanceled;
  FCancel := true;
  if Assigned(FOnCancel) then
    FOnCancel(Self);
  inherited;
end;

constructor TcCreateDBV2.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csReplicatable];
  FDatabases := TcDatabases.Create(TcDatabase);
  FBeforeDBCommand := TStringList.Create;
  FAfterDBCommand := TStringList.Create;
  FCancel := true;
  Visible := true;
end;

destructor TcCreateDBV2.Destroy;
begin
  FDatabases.Free;
  FBeforeDBCommand.Free;
  FAfterDBCommand.Free;
  inherited;
end;

procedure TcCreateDBV2.ErrorMsg(var aMsg: TMessage);
begin
  FCancel := true;
  FState := cErrored;
  if Assigned(FOnError) then
    FOnError(Self);
  inherited;
end;

procedure TcCreateDBV2.Execute;
begin
  if (Databases.Count < 1) or (Not Assigned(Connection)) then
    Raise Exception.Create('未指定执行脚本！');
  FCancel := false;
  FState := cDoing;
  TcCreateDBV2Thread.Create(Self);
end;

procedure TcCreateDBV2.FinishMsg(var aMsg: TMessage);
begin
  FCancel := true;
  FState := cFinish;
  if Assigned(FOnFinish) then
    FOnFinish(Self);
  inherited;
end;

function TcCreateDBV2.getDatabases: TcDatabases;
begin
  result := FDatabases;
end;

procedure TcCreateDBV2.setDatabases(const Value: TcDatabases);
begin
  FDatabases.Assign(Value);
end;

function TcCreateDBV2.getAfterDBCommand: TStrings;
begin
  result := FAfterDBCommand;
end;

function TcCreateDBV2.getBeforeDBCommand: TStrings;
begin
  result := FBeforeDBCommand;
end;

procedure TcCreateDBV2.setAfterDBCommand(const Value: TStrings);
begin
  if Assigned(Value) then
    FAfterDBCommand.Assign(Value)
  else
    FAfterDBCommand.Clear;
end;

procedure TcCreateDBV2.setBeforeDBCommand(const Value: TStrings);
begin
  if Assigned(Value) then
    FBeforeDBCommand.Assign(Value)
  else
    FBeforeDBCommand.Clear;
end;

procedure TcCreateDBV2.setFADOCN(Value: TADOConnection);
begin
  FADOCN := Value;
end;

procedure TcCreateDBV2.Paint;
begin
  if csDesigning in ComponentState then begin
    Canvas.Brush.Color := Parent.Brush.Color;
    Canvas.Font.Color := clBlack;
    Canvas.FillRect(ClientRect);
    Canvas.Pen.Style := psDashDot;
    Canvas.Rectangle(ClientRect);
    Canvas.TextOut(1, 1, Caption + '.JS96');
  end;
end;

{ TcDatabase }

procedure TcDatabase.Assign(Source: TPersistent);
begin
  if Source is TcDatabase then begin
    FDBName := TcDatabase(Source).FDBName;
    FStrucDef.Assign(TcDatabase(Source).FStrucDef);
    FSuspendData.Assign(TcDatabase(Source).FSuspendData);
  end else
    inherited Assign(Source);
end;

constructor TcDatabase.Create(Collection: TCollection);
begin
  inherited;
  FStrucDef := TStringList.Create;
  FSuspendData := TStringList.Create;
end;

destructor TcDatabase.Destroy;
begin
  FStrucDef.Free;
  FSuspendData.Free;
  inherited;
end;

function TcDatabase.getDBName: String;
begin
  result := FDBName;
end;

function TcDatabase.getStrucDef: TStrings;
begin
  result := FStrucDef;
end;

function TcDatabase.getSuspendData: TStrings;
begin
  result := FSuspendData;
end;

procedure TcDatabase.setDBName(const Value: String);
begin
  FDBName := Value;
end;

procedure TcDatabase.setStrucDef(const Value: TStrings);
begin
  FStrucDef.Assign(Value);
end;

procedure TcDatabase.setSuspendData(const Value: TStrings);
begin
  FSuspendData.Assign(Value);
end;

{ TcDatabases }

function TcDatabases.Add: TcDatabase;
begin
  result := TcDatabase.Create(Self); 
end;

procedure TcDatabases.Assign(Source: TPersistent);
var
  i: Integer;
begin
  if Source is TcDatabases then begin
    Clear;
    for i := 0 to TcDatabases(Source).Count -1 do
      Add.Assign(TcDatabases(Source).Items[i]);
  end else
    inherited Assign(Source);
end;

function TcDatabases.GetItem(Index: Integer): TcDatabase;
begin
  result := TcDataBase(inherited GetItem(Index));
end;

procedure TcDatabases.SetItem(Index: Integer; const Value: TcDatabase);
begin
  inherited SetItem(Index, Value);
end;

{ TcCreateDBV2Thread }

constructor TcCreateDBV2Thread.Create(var Parent: TcCreateDBV2);
var
  i: Integer;
begin
  inherited Create(true);
  FParent := Parent;
  FADOQ := TADOQuery.Create(Nil);
  FADOQ.Connection := FParent.Connection;
  FADOQ.ParamCheck := false;
  //FADOQ.Prepared := true;
  FreeOnTerminate := true;
  if Assigned(FParent.ProgressBar) then begin
    FParent.ProgressBar.Max := FParent.BeforeDBCommand.Count + FParent.AfterDBCommand.Count;
    for i := 0 to FParent.Databases.Count - 1 do
      FParent.ProgressBar.Max := FParent.ProgressBar.Max +
        FParent.Databases.Items[i].StrucDef.Count +
        FParent.Databases.Items[i].SuspendData.Count;
    FParent.ProgressBar.Position := 0;
  end;
  Resume;
end;

destructor TcCreateDBV2Thread.Destroy;
begin
  if FADOQ.Active then FADOQ.Close;
  FADOQ.Free;
  if Assigned(FParent.ProgressBar) then
  begin
    FParent.ProgressBar.Position := 0;
    FParent.ProgressBar.Max := 0; 
  end;
  inherited;
end;

procedure TcCreateDBV2Thread.Execute;
var
  i, j: Integer;
  f: textfile;
begin
  try
    Screen.Cursor := crAppStart;
    try
      //Before database command
      for i := 0 to FParent.BeforeDBCommand.Count - 1 do begin
        StepIt;
        if UpperCase(Trim(FParent.BeforeDBCommand.Strings[i])) = 'GO' then
          Submit
        else if Trim(FParent.BeforeDBCommand.Strings[i]) <> '' then
          FADOQ.SQL.Add(Trim(FParent.BeforeDBCommand.Strings[i]));
      end;
      Submit;
      //databases
      for i := 0 to FParent.Databases.Count - 1 do begin
        if FParent.FCancel then begin
          PostMessage(FParent.Handle, cCancelMsg, 0, 0);
          Exit;
        end;
        FADOQ.SQL.Clear;
        FADOQ.SQL.Add('use master');
        Submit;
        //是否覆盖
        if FParent.ReplaceExists then begin
          FADOQ.SQL.Add(
          'if Exists(Select * from sysdatabases where name = ''' + FParent.Databases.Items[i].DBName + ''') ' +
          'begin ' +
          '  drop database ' + FParent.Databases.Items[i].DBName + ' ' +
          'end '
          );
          Submit;
        end;
        //结构
        for j := 0 to FParent.Databases.Items[i].StrucDef.Count - 1 do begin
          StepIt;
          if UpperCase(Trim(FParent.Databases.Items[i].StrucDef[j])) = 'GO' then
            Submit
          else if Trim(FParent.Databases.Items[i].StrucDef[j]) <> '' then
            FADOQ.SQL.Add(Trim(FParent.Databases.Items[i].StrucDef[j]));
        end;
        Submit;
        //缺省数据
        FADOQ.SQL.Add('use ' + FParent.Databases.Items[i].DBName + ' ');
        for j := 0 to FParent.Databases.Items[i].SuspendData.Count - 1 do begin
          StepIt;
          if UpperCase(Trim(FParent.Databases.Items[i].SuspendData[j])) = 'GO' then
            Submit
          else if Trim(FParent.Databases.Items[i].SuspendData[j]) <> '' then
            FADOQ.SQL.Add(Trim(FParent.Databases.Items[i].SuspendData[j]));
        end;
        Submit;
      end;
      //after database command
      for i := 0 to FParent.AfterDBCommand.Count - 1 do begin
        StepIt;
        if UpperCase(Trim(FParent.AfterDBCommand.Strings[i])) = 'GO' then
          Submit
        else if Trim(FParent.AfterDBCommand.Strings[i]) <> '' then
          FADOQ.SQL.Add(Trim(FParent.AfterDBCommand.Strings[i]));
      end;
      Submit;
      PostMessage(FParent.Handle, cFinishMsg, 0, 0);
    except
      On E: Exception do begin
        AssignFile(f, ExtractFilePath(Application.ExeName) + 'error.log');
        ReWrite(f);
        Writeln(f, '--- [' + E.ClassName + '] ' + E.Message + ' ---');  
        for i := 0 to FADOQ.SQL.Count - 1 do
          Writeln(f, FADOQ.SQL[i]);
        CloseFile(f);
        PostMessage(FParent.Handle, cErrorMsg, 0, 0);
        Terminate;
      end;
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TcCreateDBV2Thread.StepIt;
begin
  if Assigned(FParent.ProgressBar) then
    FParent.ProgressBar.StepBy(1);
end;

procedure TcCreateDBV2Thread.Submit;
begin
  if FADOQ.SQL.Count < 1 then Exit;
  FADOQ.ExecSQL;
  FADOQ.Close;
  FADOQ.SQL.Clear;
  Application.ProcessMessages;
end;

end.