repair.pas

对金智能试卷软件的功能补充

unit repair;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Word2000,comobj, DBGrids, OleCtrls, OleCtnrs, DB, DBTables;

type
  Tfrmrepair = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmrepair: Tfrmrepair;
  filename : string;
implementation

uses main;

{$R *.dfm}

procedure Tfrmrepair.Button2Click(Sender: TObject);
var
   Wordapp    : OleVariant;
   Hword      : Thandle;
   worddoc    : OleVariant;
   shiti_doc  : OleVariant;
   daan_doc   : OleVariant;
   i          : integer;
   nupos      : integer;
   count      : integer;
   SStr       : string;
   DStr       : string;
   WStr       : string;
   ID         : string;

begin
     close;
     if not frmtkaid.tbl_tk.Active  then
       begin
           showmessage('未连接数据库，或数据文件读取错误');
           exit;
       end;
     if trim(edit1.text) = '' then
       begin
           showmessage('未指定文件名');
           exit;
       end;
     if  Uppercase(ExtractFileExt(edit1.text)) <> '.DOC'  then
        begin
           showmessage('指定的文件类型不对');
           exit;
        end;
     if not FileExists(filename) then
        begin
           showmessage('指定的文件不存在');
           exit;
        end;

    if MessageDlg('确定要将WORD文件的修改内容写回题库数据库吗',
                    mtConfirmation,mbOKCancel,0) = mrCancel then
       exit;

    if FileExists('c:\~shiti_temp.doc') then
       DeleteFile('c:\~shiti_temp.doc');

    if FileExists('c:\~daan_temp.doc') then
       DeleteFile('c:\~daan_temp.doc');

   HWord:=FindWindow(NIL,'Microsoft Word');
   if (hWord = 0)  THEN
      begin
         try
            Wordapp := CreateOleObject('Word.Application');
         except
            ShowMessage('启动 Microsoft word 失败'+#13+ '请检查word是否正确安装');
            Exit;
         end;
      end
   else
      Wordapp := GetActiveOleObject('Word.Application');

   try
      wordDoc := WordApp.Documents.Open(filename);
      shiti_doc := WordApp.Documents.Add;
      daan_doc := WordApp.Documents.Add;
      shiti_doc.SaveAs('c:\~shiti_temp.doc');
      daan_doc.SaveAs('c:\~daan_temp.doc');

      if wordDoc.sentences.count < 2 then
         begin
           showmessage('文件格式不正确');
           exit;
         end;

      for i:= 1 to  wordDoc.sentences.count do
      begin
          wStr  := wordDoc.sentences.item(i).text;
          wStr  := Trim(wStr);
          count := length(wStr);
          nupos := pos(' ' ,wStr);
          if WStr[1] in ['0'..'9'] then
             begin
                 if daan_doc.range.words.count > 2 then     {保存前一道题的答案内容}
                 begin
                     Dstr:='';
                     daan_doc.close(wdSaveChanges);
                     with  frmtkaid.tbl_tk do
                     begin
                         First;
                         if StrToInt(ID) > 1 then
                         MoveBy( StrToInt(ID)- 1 );
                         Edit;
                         TBlobField(FieldByName('Daan')).LoadFromFile('c:\~daan_temp.doc');
                         Post;
                     end;
                 end;

                 ID := copy( wStr ,1 ,nupos-1);
                 SStr := copy( wStr ,nupos+1 ,count-nupos);
                 if  FindWindow(NIL,'~shiti_temp - Microsoft Word') <> 0 then
                     shiti_doc.close(wdSaveChanges);
                 shiti_doc := WordApp.Documents.open('c:\~shiti_temp.doc');
                 shiti_doc.Content.Select ;
                 wordapp.Selection.Delete ;
                 wordapp.selection.typetext(SStr);

             end
         else if  copy(wStr ,1 ,nupos-1) = '答案：' then
             begin
                  Sstr:='';
                  shiti_doc.SaveAs('c:\~shiti_temp.doc');
                  if shiti_doc.range.words.count > 2 then       {保存前一道题的试题内容}
                  begin
                      shiti_doc.close(wdSaveChanges);
                      with  frmtkaid.tbl_tk do
                      begin
                          First;
                          if StrToInt(ID) > 1 then
                          MoveBy( StrToInt(ID)- 1 );
                          Edit;
                          TBlobField(FieldByName('Shiti')).LoadFromFile('c:\~shiti_temp.doc');
                          Post;
                      end;
                  end;

                  DStr:= copy(wStr,nupos+1,count-nupos);
                  if  FindWindow(NIL,'~daan_temp - Microsoft Word') <> 0 then
                  daan_doc.close(wdSaveChanges);
                  daan_doc := WordApp.Documents.open('c:\~daan_temp.doc');
                  daan_doc.Content.Select ;
                  wordapp.Selection.Delete;
                  wordapp.selection.typetext(DStr);
             end
             else
             begin

                  if (Dstr = '') and (Sstr <> '') then
                     begin
                         SStr := COPY(wStr,1,LENGTH(wStr)) ;
                         wordapp.selection.typetext(SStr);
                     end;
                  if (Sstr = '') and (Dstr <> '') then
                     begin
                         DStr := COPY(wStr,1,LENGTH(wStr)) ;
                         wordapp.selection.typetext(DStr);
                     end;
                     
             end;
         end;

         if daan_doc.range.words.count > 2 then
            begin
                Dstr:='';
                daan_doc.close(wdSaveChanges);
                with  frmtkaid.tbl_tk do
                begin
                    First;
                    if StrToInt(ID) > 1 then
                    MoveBy( StrToInt(ID)- 1 );
                    Edit;
                    TBlobField(FieldByName('Daan')).LoadFromFile('c:\~daan_temp.doc');
                    Post;
                end;
           end;
   finally
         wordDoc.close(wdSaveChanges);
         if not VarIsEmpty(wordapp) then
            wordapp.Quit;
         wordapp := Unassigned;
   end;

   showmessage('成功将更改文件存入数据库');
end;

procedure Tfrmrepair.Button1Click(Sender: TObject);
begin
      if OpenDialog1.Execute then
         filename := OpenDialog1.FileName;
      Edit1.Text := filename;
end;

end.