rl_unit2.pas

一个很不错的绿色小软件 可以实现 上网 一个小助手

unit rl_Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;
  
Function check():boolean; //检查文件是否存在,如果存在返回true,否则返回false.
function Del_Rec():boolean;//删除记录

type
  TForm4 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    rl_title: TEdit;
    rl_dtp_date: TDateTimePicker;
    rl_dtp_time: TDateTimePicker;
    rl_Check_sound: TCheckBox;
    rl_memo_txnr: TMemo;
    rl_delete: TButton;
    rl_enter: TButton;
    rl_chale: TButton;
    procedure rl_deleteClick(Sender: TObject);
    procedure rl_enterClick(Sender: TObject);
    procedure rl_chaleClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
//--------------------------------------------------------
type                     //定义记录
  info=record
  ts_title:string[20];
  ts_date:string[20];
  ts_time:string[20];
  ts_text:string[100];
  ts_clock:boolean;
  end;
//----------------------------------------------------------

var
  Form4: TForm4;

implementation
uses rl_unit1;
{$R *.dfm}
//------------------------------------------------------------------------------
Function check():boolean; //检查文件是否存在,如果存在返回true,否则返回false.   *******************
var
  ts_info:file of info;
Begin  
  AssignFile(ts_info,'wjt.wss');
  try
  reset(ts_info);
  result:=true;    //存在文件时直接打开进入
  except
  On EInOutError do
    begin
    try
    if FileExists('wjt.wss')=false then  //当文件不存在时,可新建文件
      begin
      ReWrite(ts_info);
      result:=true;
      end
    else
      begin
      result:=False;
      MessageDlg('文件不能打开',mtWarning,[mbOK],0);
      end;
    except
    On EInOutError do
      begin
      result:=false;
      MessageDlg('文件不能被创建',mtWarning,[mbOK],0);
      end;
    end;
  end;
 end;
 closefile(ts_info);
End;
//------------------------------------------------------------------------------
//判断新添加记录或修改记录标题与日期是否重复记录           *****************************
function add_nolike(add_title:string;add_datetime:Tdatetime):boolean;
var i:integer;
    ts_info:file of info;
    infoRec:info;
    count:integer;
begin
  if check() then
  begin
    AssignFile(ts_info,'wjt.wss');
    reset(ts_info);
    count:=filesize(ts_info);
    for i:=0 to count-1 do
    begin
    seek(ts_info,i);
    read(ts_info,infoRec);
    if(add_title=infoRec.ts_title) and (add_datetime=StrToDatetime(infoRec.ts_date+' '+infoRec.ts_time)) then
    begin
    result:=false;
    break;
    end
    else result:=true;
    end;
  closefile(ts_info);
  end;
end;
//------------------------------------------------------------------------------
//每次事件文件改变时调用该过程,获取一条距当前时间最近的将来记录           ****************************
function get_ts_datetime():TDatetime;   //返回一个日期,作为时钟开始工作的对象
var i,count:integer;
    ts_info:file of info;
    infoRec:info;
begin
  AssignFile(ts_info,'wjt.wss');
  reset(ts_info);
  count:=filesize(ts_info);
  for i:=0 to count-1 do
  begin
    seek(ts_info,i);
    read(ts_info,infoRec);
    if infoRec.ts_clock=true then
    begin
      if (strToDate(infoRec.ts_date)>date) or ((StrToDate(infoRec.ts_date)=date) and (strTotime(infoRec.ts_time)>time)) then
      begin
        result:=strToDatetime(infoRec.ts_date+' '+infoRec.ts_time);
        closefile(ts_info);
        exit;
      end;
    end;
  end;
  closefile(ts_info);
end;
//------------------------------------------------------------------------------
Function add():boolean;  //在文件中添加新记录,按时间由小到大插入         **********************
var i:integer;
    newf:file of info;
    newinfoRec:info;
    newcount:integer;
    str:string;
    compare:boolean;

    ts_info:file of info;
    infoRec:info;
    count:integer;
Begin
  if check() then
  begin
     AssignFile(ts_info,'wjt.wss');
     reset(ts_info);
     infoRec.ts_title:=Form4.rl_title.Text;          //从信息框中采集信息记录
     infoRec.ts_date:=DateToStr(Form4.rl_dtp_date.Date);
     infoRec.ts_time:=TimeToStr(Form4.rl_dtp_time.Time);
     infoRec.ts_text:=Form4.rl_memo_txnr.Text;
     infoRec.ts_clock:=Form4.rl_Check_sound.Checked;

     if not add_nolike(infoRec.ts_title,strToDatetime(infoRec.ts_date+' '+infoRec.ts_time)) then//当有重复项时跳出重新输入新值
      begin
      showmessage('同一时间请输入不同的标题!');
      closefile(ts_info);
      abort;  //终止当前事件,重新等待开始
     end;
     count:=filesize(ts_info);
     compare:=false;
     str:=changefileExt('wjt.wss','.wjt');        //生成以.wjt为后缀的新文件
     Assignfile(newf,str);
     rewrite(newf);                  //以写的形式初始化ttt.wjt文件

     if count<=0 then
     begin
      write(newf,infoRec);
     end
     else
     begin
     for i:=0 to count-1 do          //依次从ttt.txt中读出记录,同infoRec日期对比,较小时直接插入到ttt.wjt中
     begin
      newcount:=filesize(newf);

      seek(newf,newcount);
      seek(ts_info,i);
      read(ts_info,newinfoRec);
      if ((StrToDate(infoRec.ts_date)<StrToDate(newinfoRec.ts_date)) or ((StrToDate(infoRec.ts_date)=StrToDate(newinfoRec.ts_date)) and (strToTime(infoRec.ts_time)<=StrToTime(newinfoRec.ts_time)))) and (compare=false) then
      begin
        write(newf,infoRec);
        write(newf,newinfoRec);
        compare:=true;
      end
      else
      write(newf,newinfoRec);
     end;

     if compare=false then      //当新插入的记录的日期最大时,将文件指针指到结尾,插入记录
     begin
     seek(newf,i);
     write(newf,infoRec);
     end;
     end;
     closefile(newf);
     closefile(ts_info);
     deletefile('wjt.wss');           //删除原文件ttt.txt
     renamefile('wjt.wjt','wjt.wss'); //将ttt.wjt重命名为ttt.txt
     datetime_back:=get_ts_datetime;  //添加新记录时,更新datetime_back值
  end;
  result:=true;
End;
//------------------------------------------------------------------------------
function Del_Rec():boolean;   //删除记录                    *************************
var i:integer;
    newf:file of info;
    newcount:integer;
    str:string;

    ts_info:file of info;
    infoRec:info;
    count:integer;
Begin
  if check() then
  begin
     AssignFile(ts_info,'wjt.wss');
     reset(ts_info);
     count:=filesize(ts_info);
     str:=changefileExt('wjt.wss','.wjt');        //生成以.wjt为后缀的新文件
     Assignfile(newf,str);
     rewrite(newf);                  //以写的形式初始化ttt.wjt文件

     for i:=0 to count-1 do          //依次从ttt.txt中读出记录,同infoRec日期对比,较小时直接插入到ttt.wjt中
     begin
      newcount:=filesize(newf);
      seek(newf,newcount);
      seek(ts_info,i);
      read(ts_info,infoRec);
      if (infoRec.ts_title=Form3.rl_lv_rc.Selected.Caption) and (StrToDatetime(infoRec.ts_date+' '+infoRec.ts_time)=StrToDatetime(Form3.rl_lv_rc.Selected.SubItems.Text)) then
      continue
      else
        write(newf,infoRec);
     end;
     closefile(newf);
     closefile(ts_info);
     deletefile('wjt.wss');           //删除原文件ttt.txt
     renamefile('wjt.wjt','wjt.wss'); //将ttt.wjt重命名为ttt.txt
     datetime_back:=get_ts_datetime;  //删除记录时,更新datetime_back值
  end;
  result:=true;
end;
//------------------------------------------------------------------------------
procedure updateto;
begin
  Del_Rec();
  add();
  browse(true,date);
end;
//------------------------------------------------------------------------------

procedure TForm4.rl_deleteClick(Sender: TObject);
begin
enter:=3;
Form4.rl_memo_txnr.Clear;
end;
//-----------------------------------------------------------
procedure TForm4.rl_enterClick(Sender: TObject);
begin
 if rl_title.Text<>''then
  begin
    if enter=1 then
    begin
      add();
      ShowMessage('记录成功!');
    end
    else if enter=2 then
    begin
      updateto;
      showMessage('更新成功!');
    end
    else if enter=3 then
    begin
      Del_Rec();
    end;
    Form4.Close;
    browse(true,date);
  end
  else
    ShowMessage('您还没有填写标题和内容');
end;
//-------------------------------------------------------------------------------


procedure TForm4.rl_chaleClick(Sender: TObject);
begin
Form4.Close;
end;

end.