mainunit.pas

初次上传,不太会规类.这是一个电子文档收集的软件.支持从浏览器窗口中托拽到本地窗口中.个人以为比网文快抓,webcollecter之类的好.小,绿色,适用.

  begin
    DataType:=2;
    Author[0]:=#0;
    Password[0]:=#0;
    Num:=0;
  end;
  ANode.EditText;
  StatusBar.Refresh;
  DataChange:=true;
  IndexChange:=true;
end;
//编辑节点-------------------------------------------------------------
procedure TSrmForm.EditNodeMenuItemClick(Sender: TObject);
begin
  TreeView.Selected.EditText;
  IndexChange:=true;
end;
//删除节点-------------------------------------------------------------
procedure TSrmForm.DelNodeMenuItemClick(Sender: TObject);
begin
  if Application.MessageBox(csDeleteQuery,
         csAppName,MB_OKCANCEL or MB_ICONWARNING)=IDOK then
  begin
    ActiveNode:=nil;
    TreeView.Selected.Delete;
    StatusBar.Refresh;
    IndexChange:=true;
  end;
end;
//节点排序--------------------------------------------------------------
procedure TSrmForm.SortMenuItemClick(Sender: TObject);
begin
  Screen.Cursor:=crHourGlass;
  Application.ProcessMessages;

  TreeView.SortType:=stText;
  TreeView.AlphaSort;
  TreeView.SortType:=stNone;
  IndexChange:=true;
  Screen.Cursor:=crDefault;
end;
//压缩数据库------------------------------------------------------------
procedure TSrmForm.CompressMenuItemClick(Sender: TObject);
var
  i,n:integer;
  Ms,Msh,Msd:TMemoryStream;
  ASrm:TSrmObject;
  AFileName,AoldFileName:string;
  ABuf:array[0..260] of char;
  ANode:TTreeNode;
  pBuf:PTreeData;
begin
  AOldFileName:=Srm.FileName;
  if TreeView.Selected=nil then
  begin
    CloseSrm;
    DeleteFile(AOldFileName);
    Srm:=TSrmObject.Create(AOldFileName,fmCreate);
  end
  else
  begin
    SaveSrm;

    GetTempFileName(pchar(ExtractFileDir(Srm.FileName)),'tmp',0,@ABuf[0]);
    AFileName:=string(ABuf);
    Ms:=TMemoryStream.Create;
    Msh:=TMemoryStream.Create;
    Msd:=TMemoryStream.Create;
    TreeView.SaveToStream(Msh);
    Msd.SetSize(sizeof(TTreeData)*TreeView.Items.Count);
    pBuf:=Msd.Memory;
    ASrm:=TSrmObject.Create(AFileName,fmCreate);
    n:=TreeView.Items.Count-1;
    ANode:=TreeView.Items.GetFirstNode;
    Screen.Cursor:=crHourGlass;
    Application.ProcessMessages;

    with TProgressBar.Create(self) do
    begin
      Parent:=LeftBottomPanel;
      Align:=alClient;
      Max:=n;
      StatusBar.Update;
      Update;
      for i:=0 to n do
      begin
        Position:=i;
        Update;
        Srm.ReadItemHead(integer(ANode.Data));
        Srm.ReadItemData(Ms);
        ASrm.DataHead:=Srm.DataHead;
        pBuf^.Pos:=ASrm.AddItemHead;
        if ANode.GetFirstChild<>nil then pBuf^.DataType:=1
        else pBuf^.DataType:=ANode.ImageIndex;
        ASrm.AddItemData(Ms);
        pBuf:=PTreeData(integer(pBuf)+sizeof(TTreeData));
        ANode:=ANode.GetNext;
      end;
      ASrm.FileHead:=Srm.FileHead;
      ASrm.SaveIndex(Msh,Msd);
      ASrm.SaveSrmFile;
      Free;
    end;

    Screen.Cursor:=crDefault;
    ASrm.Free;
    Ms.Free;
    Msh.Free;
    Msd.Free;

    CloseSrm;
    DeleteFile(AOldFileName);
    MoveFile(pchar(AFileName),pchar(AOldFileName));
    OpenSrm(AOldFileName);
  end;
  StatusBar.Refresh;
end;
//恢复被删除数据----------------------------------------------------------
procedure TSrmForm.UnDelMenuItemClick(Sender: TObject);
begin
//
end;
//修复数据库-----------------------------------------------------------
procedure TSrmForm.RepareMenuItemClick(Sender: TObject);
begin
//
end;
//升级2.x版数据库-------------------------------------------------------
procedure TSrmForm.CovertMenuItemClick(Sender: TObject);
var
  Fn: string;
  F2,F3:integer;
  FTv:TTreeView;
  IdxBuf:PIntArray;
  Ms,Msh,Msd:TMemoryStream;
  i,n,size:integer;
  FSrm:TSrmObject;
  ANode:TTreeNode;
begin
  if CloseSrmQuery then CloseSrm else exit;  //关闭打开的数据文件
  //得打开文件名和要保存的文件名
  with OpenDialog do
  begin
    DefaultExt:=csTreExt;
    Filter:=csOldFilter;
    Title:=csOpenTitle;
  end;
  with SaveDialog do
  begin
    DefaultExt:=csSrmExt;
    Filter:=csSrmFilter;
    Title:=csSaveAsTitle;
  end;
  if not OpenDialog.Execute then Exit;
  if not SaveDialog.Execute then Exit;
  //旧数据文件不完整时
  Fn:=OpenDialog.FileName;
  Delete(Fn,Length(Fn)-2,3);
  if not (FileExists(Fn+csTreExt) and
          FileExists(Fn+csIdxExt) and
          FileExists(Fn+csDatExt)) then
  begin
    Application.MessageBox(csOldFileError,csAppName,MB_OK+MB_ICONSTOP);
    exit;
  end;

  FSrm:=TSrmObject.Create(SaveDialog.FileName,fmCreate);
  Ms:=TMemoryStream.Create;
  Msh:=TMemoryStream.Create;
  Msd:=TMemoryStream.Create;
  //装入标题到隐藏的视图中
  FTv:=TTreeView.Create(self);
  FTv.Parent:=self;
  FTv.Visible:=false;
  FTv.LoadFromFile(Fn+csTreExt);
  ANode:=FTv.Items.GetFirstNode;
  //读入索引
  GetMem(IdxBuf,sizeof(integer)*FTv.Items.Count);
  Msd.SetSize(sizeof(TTreeData)*FTv.Items.Count);
  F2:=FileOpen(Fn+csIdxExt,fmOpenRead);
  FileRead(F2,IdxBuf^,sizeof(integer)*FTv.Items.Count);

  F3:=FileOpen(Fn+csDatExt,fmOpenRead);

  n:=FTv.Items.Count-1;
  Screen.Cursor:=crHourGlass;
  Application.ProcessMessages;
  with TProgressBar.Create(self) do
  begin
    Parent:=LeftBottomPanel;
    Align:=alClient;
    Max:=n;
    StatusBar.Update;
    Update;

    for i:=0 to n do
    begin
      Position:=i;
      Update;
      //置数据段头缺省值
      with FSrm.DataHead do
      begin
        Author[0]:=#0;
        Password[0]:=#0;
        SearchKey[0]:=#0;
        Keep:=0;
        PubDate:=Now;
        if (ANode.GetFirstChild<>nil) then
          DataType:=1
        else
          DataType:=2;
        if IdxBuf^[i]=-1 then
          Num:=0
        else
          Num:=1;
//          Num:=0;
      end;
      PTdArray(Msd.Memory)^[i].DataType:=FSrm.DataHead.DataType;
      PTdArray(Msd.Memory)^[i].Pos:=FSrm.AddItemHead;
      //读入数据内容
      if IdxBuf^[i]<>-1 then
      begin
        FileSeek(F3,IdxBuf^[i],0);
        FileRead(F3,size,sizeof(integer));
        Ms.SetSize(size);
        FileRead(F3,Ms.Memory^,size);
        FSrm.AddItemData(Ms);
      end;
      ANode:=ANode.GetNext;
    end;
    Free;
  end;
  Screen.Cursor:=crDefault;
  //保存新文件索引
  FTv.SaveToStream(Msh);
  FSrm.SaveIndex(Msh,Msd);
  FSrm.SaveSrmFile;
  //释放内存
  FreeMem(IdxBuf);
  FileClose(F2);
  FileClose(F3);
  FTv.Free;
  Ms.Free;
  Msd.Free;
  Msh.Free;
  FSrm.Free;
  OpenSrm(SaveDialog.FileName);
end;



//****************************************************************
//关于本软件----------------------------------------------------------
procedure TSrmForm.AboutMenuItemClick(Sender: TObject);
begin
  with TAboutForm.Create(self) do
  begin
    ShowModal;
    Free;
  end;
end;
//帮助文件----------------------------------------------------------
procedure TSrmForm.ReadmeMenuItemClick(Sender: TObject);
var
  TmpStr :string;
begin
  TmpStr:=Application.ExeName;
  Delete(TmpStr,Length(TmpStr)-2,3);
  TmpStr:=TmpStr+csHlpExt;
  if Sender is TWinControl then
  begin
    if TWinControl(Sender).HelpContext=0 then
      WinHelp(Application.Handle,pchar(TmpStr),HELP_CONTEXT,10)
    else
      WinHelp(Application.Handle,pchar(TmpStr),HELP_CONTEXT,
              TWinControl(Sender).HelpContext);
  end
  else
      WinHelp(Application.Handle,pchar(TmpStr),HELP_CONTEXT,10);
end;
//作者主页----------------------------------------------------------
procedure TSrmForm.HomePageMenuItemClick(Sender: TObject);
begin
  ShellExecute(Application.Handle,nil,csHomePage,nil,nil,SW_SHOWNORMAL);
end;
//作者邮件----------------------------------------------------------
procedure TSrmForm.EMailMenuItemClick(Sender: TObject);
begin
  ShellExecute(Application.Handle,nil,csEMail,nil,nil,SW_SHOWNORMAL);
end;
//技术支持----------------------------------------------------------
procedure TSrmForm.OtherMenuItemClick(Sender: TObject);
begin
  Application.MessageBox(csTechniqueSupport,csAppName,MB_OK+MB_ICONSTOP);
end;




//****************************************************************



procedure TSrmForm.FileMenuItemClick(Sender: TObject);
begin
  if Srm=nil then    //没有打开的数据库时
  begin
    SaveMenuItem.Enabled:=false;
    CloseMenuItem.Enabled:=false;
    FImportMenuItem.Enabled:=false;
    DImportMenuItem.Enabled:=false;
  end
  else
  begin
    SaveMenuItem.Enabled:=true;
    CloseMenuItem.Enabled:=true;
    FImportMenuItem.Enabled:=true;
    DImportMenuItem.Enabled:=true;
    end;

  if TreeView.Selected=nil then   //没有被选择的标题时
  begin
    ExportMenuItem.Enabled:=false;
    PrintMenuItem.Enabled:=false;
  end
  else
  begin
    ExportMenuItem.Enabled:=true;
    PrintMenuItem.Enabled:=true;
  end;
end;

procedure TSrmForm.EditMenuItemClick(Sender: TObject);
begin
  if RichEdit.SelLength=0 then  //没有被选择的文本时
  begin
    CutMenuItem.Enabled:=false;
    CopyMenuItem.Enabled:=false;
  end
  else
  begin
    CutMenuItem.Enabled:=true;
    CopyMenuItem.Enabled:=true;
  end;
  if RichEdit.Modified=false then  //内容还未被修改过时
  begin
    UndoMenuItem.Enabled:=false;
    RedoMenuItem.Enabled:=false;
  end
  else
  begin
    UndoMenuItem.Enabled:=true;
    RedoMenuItem.Enabled:=true;
  end;
  OpenClipboard(Handle);
  if GetClipboardData(CF_TEXT)=0 then  //剪贴板中没有文本时
    PasteMenuItem.Enabled:=false
  else
    PasteMenuItem.enabled:=true;
  CloseClipboard;
  if RichEdit.SelLength>=RichEdit.GetTextLen then
    SelAllMenuItem.Enabled:=false
  else
    SelAllMenuItem.Enabled:=true;
end;


procedure TSrmForm.DbAuthorEditChange(Sender: TObject);
begin
  FileChange:=true;
end;

procedure TSrmForm.ContextAuthorEditChange(Sender: TObject);
begin
  if RightPageControl.ActivePage=ProTabSheet then
    DataChange:=true;
end;
procedure TSrmForm.ContextTypeRadioGroupClick(Sender: TObject);
begin
  if RightPageControl.ActivePage=ProTabSheet then
  begin
    DataChange:=true;
    if TreeView.Selected<>nil then
      TreeView.Selected.ImageIndex:=ContextTypeRadioGroup.ItemIndex+1;
    IndexChange:=true;
  end;
end;


procedure TSrmForm.PrevToolButtonClick(Sender: TObject);
begin
  if TreeView.Selected.GetPrev<>nil then
    TreeView.Selected:=TreeView.Selected.GetPrev;
end;

procedure TSrmForm.NextToolButtonClick(Sender: TObject);
begin
  if TreeView.Selected.GetNext<>nil then
    TreeView.Selected:=TreeView.Selected.GetNext;
end;






procedure TSrmForm.RichEditChange(Sender: TObject);
begin
  StatusBar.Refresh;
end;

end.