udiarymain.pas

delphi com addin

//*************************************************************************
//            　　　　　　　　主单元　　　                                *
//                                                                        *
//                           　　　All Copy Right Reserved by Tassadar    *
//*************************************************************************
unit UDiaryMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, Grids, DBGridEh, ADODB, ComCtrls, ExtCtrls, StdCtrls, DBCtrls,
  Word97, OleServer, ImgList, ToolWin, DBGrids, WordDiary_TLB, Word2000;

type
  TfmDiary = class(TForm)
    acDiary: TADOConnection;
    tbDiary: TADOTable;
    dsDisry: TDataSource;
    tbDiaryCode: TAutoIncField;
    tbDiarydate: TDateTimeField;
    tbDiaryTitle: TWideStringField;
    tbDiaryGlance: TWideStringField;
    tbDiaryContent: TBlobField;
    pnlMain: TPanel;
    WordApp: TWordApplication;
    WordDoc: TWordDocument;
    ImageList1: TImageList;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    DBRichEdit1: TDBRichEdit;
    DBGridEh1: TDBGridEh;
    ToolButton4: TToolButton;
    Splitter1: TSplitter;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    procedure WordDocClose(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure WordAppQuit(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure tbDiaryBeforeCancel(DataSet: TDataSet);
    procedure ToolButton4Click(Sender: TObject);
    procedure tbDiaryBeforeInsert(DataSet: TDataSet);
    procedure acDiaryWillConnect(Connection: TADOConnection;
      var ConnectionString, UserID, Password: WideString;
      var ConnectOptions: TConnectOption; var EventStatus: TEventStatus);
    procedure FormActivate(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure tbDiaryAfterScroll(DataSet: TDataSet);
  private
    FDocOpened   : Boolean;
    FAllowNew    : Boolean;
    FSureToClose : boolean;
    TempFileName : String;
    function FGetGlance : String;
    function FGetDir    : String;
  public
    NotGood : boolean;
    procedure ShowDocument;
    procedure SaveDocument;
    procedure NewDocument;
    procedure NextDocument;
    procedure PriorDocument;
    procedure LastDocument;
    procedure FirstDocument;
    procedure DoQuit;
  end;

var
  fmDiary: TfmDiary;

implementation

uses ShellApi, UPassWord, OleCtrls;

{$R *.DFM}

{ TfmDiary }

procedure TfmDiary.ShowDocument;
var
  SaveChange, FileName : OleVariant;
  Doc : _Document;
begin
  if not tbDiary.FieldByName('Content').IsNull then
  begin
    SaveChange := False;
    if FDocOpened then
      WordDoc.Close(SaveChange, EmptyParam, EmptyParam);
    WordApp.Connect;
    tbDiaryContent.SaveToFile(TempFileName);
    FileName := TempFileName;
    Doc := WordApp.Documents.Open(FileName, EmptyParam, EmptyParam,
      EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
      EmptyParam, EmptyParam, EmptyParam, EmptyParam);
  end
  else begin
    Doc := WordApp.Documents.Add(EmptyParam, EmptyParam, EmptyParam, EmptyParam);
  end;
  WordDoc.ConnectTo(Doc);
  tbDiary.Edit;
  FDocOpened := True;
  WordApp.Visible := True;
  WordApp.Activate;
end;

procedure TfmDiary.WordDocClose(Sender: TObject);
begin
  FDocOpened := False;
  WordDoc.Disconnect;
end;

procedure TfmDiary.FormCreate(Sender: TObject);
var
  S : String;
  Pass : String;
  FTerminated : Boolean;
begin
  FSureToClose := False;

  TempFileName := FGetDir + 'Temp.Dat';
  NotGood := false;
  if Copy(ParamStr(1), 1, 1) = '-' then
  begin
    NotGood := True;
    Exit;
  end;

  try
    Pass := GetPassword;
    if Pass = '' then begin
      FTerminated := True;
      raise Exception.Create('none');
    end;
    acDiary.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;'
      + 'Data Source=' + FGetDir + 'dbWord.mdb;Mode=Share Deny Read|Share Deny Write;'
      + 'Jet OLEDB:Database Password=' + Pass + ';Jet OLEDB:Engine Type=5;';
    acDiary.Connected := True;
  except
    if not FTerminated then
      Application.MessageBox('密码错误!', '！！', mb_iconError);
    FSureToClose := True;
    Application.Terminate;
    Exit;
  end;
  tbDiary.Active := True;
  if ParamCount >= 1 then
    if Copy(ParamStr(1), 1, 1) = '/' then
    begin
      S := ParamStr(1);
      case S[2] of
        '0' : NewDocument;
        '1' : FirstDocument;
        '2' : LastDocument;
      end;
    end;
end;

procedure TfmDiary.SaveDocument;
var
  FileName   : OleVariant;
  FileStream : TFileStream;
begin
  if FDocOpened then
  begin
    if not(tbDiary.State in [dsInsert, dsEdit]) then
      tbDiary.Edit;
    FileName := TempFileName;
    WordDoc.SaveAs(FileName, EmptyParam, EmptyParam, EmptyParam,
      EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
      EmptyParam, EmptyParam);
    FileStream := TFileStream.Create(TempFileName, fmOpenRead or fmShareDenyNone);
    (tbDiary.FieldByName('Content') as TBlobField).LoadFromStream(FileStream);
    FileStream.Free;
//    tbDiary.FieldByName('Date').AsDateTime := Now;
    tbDiaryGlance.AsString := FGetGlance;
    tbDiary.Post;
  end;
end;

procedure TfmDiary.NewDocument;
var
  Doc : _Document;
  SaveChange : OleVariant;
begin
  if tbDiary.State <> dsInsert then
  begin
    WordApp.Connect;

    SaveChange := False;
    if FDocOpened then
      WordDoc.Close(SaveChange, EmptyParam, EmptyParam);

    Doc := WordApp.Documents.Add(EmptyParam, EmptyParam, EmptyParam, EmptyParam);
    WordDoc.ConnectTo(Doc);
    FDocOpened := True;
    FAllowNew := True;
    tbDiary.Append;
    tbDiary.FieldByName('Date').AsDateTime := Now;
    FAllowNew := False;
    WordApp.Selection.TypeText(DateToStr(Now) + #13#10);
    WordApp.Selection.ParagraphFormat.SpaceBeforeAuto := 0;
    WordApp.Selection.ParagraphFormat.SpaceAfterAuto := 0;
    WordApp.Selection.ParagraphFormat.FirstLineIndent := 15; 
    WordApp.Visible := True;
  end;
end;

procedure TfmDiary.ToolButton1Click(Sender: TObject);
begin
  NewDocument;
end;

procedure TfmDiary.WordAppQuit(Sender: TObject);
begin
  WordApp.Disconnect;
  Visible := True;
end;

procedure TfmDiary.ToolButton2Click(Sender: TObject);
begin
  ShowDocument;
end;

procedure TfmDiary.ToolButton3Click(Sender: TObject);
begin
  SaveDocument;
end;

function TfmDiary.FGetGlance: String;
var
  S : String;
begin
  S := WordDoc.Content.Text;
  if Length(S) <= 255 then
    S := S
  else
    S := Copy(S, 1, 255);
  Result := S;
end;

procedure TfmDiary.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FSureToClose then
  begin
    if FDocOpened then
      WordDoc.Close;
    Action := caFree;
    DeleteFile(TempFileName);
  end
  else begin
    fmDiary.Visible := false;
    Action := caNone;
    Visible := False;
  end;
end;

procedure TfmDiary.Button1Click(Sender: TObject);
begin
  DBRichEdit1.LoadMemo;
end;

procedure TfmDiary.tbDiaryBeforeCancel(DataSet: TDataSet);
var
  SaveChange : OleVariant;
begin
  if (DataSet.State = dsInsert)and FDocOpened then
  begin
    WordDoc.Close(SaveChange, EmptyParam, EmptyParam);
  end;
end;

procedure TfmDiary.ToolButton4Click(Sender: TObject);
begin
  DoQuit;
end;

procedure TfmDiary.NextDocument;
begin
  if not fmDiary.NotGood then
  with fmDiary do
  begin
    if not tbDiary.Eof then
    begin
      tbDiary.Next;
      ShowDocument;
    end;
  end
  else
    ShellExecute(0, 'Open', Pchar(ParamStr(0)), '/1', nil, SW_SHOW);
end;

procedure TfmDiary.PriorDocument;
begin
  if not fmDiary.NotGood then
  with fmDiary do
  begin
    if not tbDiary.Bof then
    begin
      tbDiary.Prior;
      ShowDocument;
    end;
  end
  else
    ShellExecute(0, 'Open', Pchar(ParamStr(0)), '/2', nil, SW_SHOW);
end;

procedure TfmDiary.FirstDocument;
begin
  if not fmDiary.NotGood then
  with fmDiary do
  begin
    if not tbDiary.Bof then
    begin
      tbDiary.First;
    end;
    ShowDocument;    
  end
  else
    ShellExecute(0, 'Open', Pchar(ParamStr(0)), '/2', nil, SW_SHOW);
end;

procedure TfmDiary.LastDocument;
begin
  if not fmDiary.NotGood then
  with fmDiary do
  begin
    if not tbDiary.Eof then
    begin
      tbDiary.Last;
      ShowDocument;
    end;
  end
  else
    ShellExecute(0, 'Open', Pchar(ParamStr(0)), '/1', nil, SW_SHOW);
end;

procedure TfmDiary.DoQuit;
begin
  FSureToClose := True;
  Close;
end;

procedure TfmDiary.tbDiaryBeforeInsert(DataSet: TDataSet);
begin
  if not FAllowNew then
    Abort;
end;

procedure TfmDiary.acDiaryWillConnect(Connection: TADOConnection;
  var ConnectionString, UserID, Password: WideString;
  var ConnectOptions: TConnectOption; var EventStatus: TEventStatus);
var
  Pass : String;
begin

end;

function TfmDiary.FGetDir: String;
begin
  Result := ExtractFileDir(ParamStr(0));
  if Result[Length(Result)] <> '\' then
    Result := Result + '\';
end;

procedure TfmDiary.FormActivate(Sender: TObject);
begin
  if FSureToClose then
    Close;
end;

procedure TfmDiary.ToolButton5Click(Sender: TObject);
begin
  tbDiary.Cancel;
end;

procedure TfmDiary.ToolButton6Click(Sender: TObject);
begin
  if Application.MessageBox('这将会是永久的失去，请考虑多几秒钟', '等等!',
    mb_iconQuestion or mb_yesNo) = idYes then
  begin
    tbDiary.Delete;
  end;
end;

procedure TfmDiary.FormShow(Sender: TObject);
begin
  Application.Restore;
end;

procedure TfmDiary.FormHide(Sender: TObject);
begin
  Application.Minimize;
end;

procedure TfmDiary.FormDeactivate(Sender: TObject);
begin
  Application.Minimize;
end;

procedure TfmDiary.tbDiaryAfterScroll(DataSet: TDataSet);
var
  SaveChange : OleVariant;
begin
  SaveChange := False;
  if FDocOpened and (dsInsert <> DataSet.State) then
  begin
    WordDoc.Close(SaveChange, EmptyParam, EmptyParam);
    FDocOpened := False;
  end;
end;

end.