⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 在企业系统运行过程中,会有大量文件生成,在西药以日期为索引的情况下就需要根据日期动态创建文件,这里提供了一个参考例程
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, FileCtrl, ComCtrls,dateutils;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    DirectoryListBox1: TDirectoryListBox;
    DriveComboBox1: TDriveComboBox;
    Label3: TLabel;
    Button2: TButton;
    Bevel2: TBevel;
    Bevel3: TBevel;
    DateTimePicker1: TDateTimePicker;
    Label4: TLabel;
    DriveComboBox2: TDriveComboBox;
    DirectoryListBox2: TDirectoryListBox;
    Image1: TImage;
    Timer1: TTimer;
    Button1: TButton;
    Button3: TButton;
    procedure DriveComboBox1Change(Sender: TObject);
    procedure DriveComboBox2Change(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DriveComboBox1Change(Sender: TObject);
begin
DirectoryListBox1.Drive:=DriveComboBox1.Drive;
end;

procedure TForm1.DriveComboBox2Change(Sender: TObject);
begin
 DirectoryListBox2.Drive:=DriveComboBox2.Drive;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   if Timetostr(Time)=Timetostr(DateTimePicker1.Time) then
     begin
       begin
       showmessage('12341234');
       IF directoryexists(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'月') then
        ELSE mkdir(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'月');
       if directoryexists(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'\'+datetostr(date)) then
       showmessage('数据')
       else begin
        chdir(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'月');
        mkdir(datetostr(date));

       end
     end;
     end;
end;




{begin
       IF directoryexists(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'月') then  ELSE mkdir(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'月');
       if directoryexists(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'\'+datetostr(date)) then
       else
       begin
       chdir(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'月');
       mkdir(datetostr(date));
       end;
end;   }

procedure TForm1.Button1Click(Sender: TObject);
begin
       IF directoryexists(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'月') then  ELSE mkdir(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'月');
       if directoryexists(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'\'+datetostr(date)) then
       else
       begin
       chdir(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'月');
       mkdir(datetostr(date));
       end;

    //    mkdir(inttostr(monthof(date))+'月'+'\'+datetostr(date));
  //     end;
  //     showmessage(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'\'+datetostr(date));
 // mkdir(inttostr(monthof(date))+'月'+'\'+datetostr(date));

//         showmessage(inttostr(monthof(date))+'月'+'\'+datetostr(date));

//end;
     end;
procedure TForm1.Button3Click(Sender: TObject);
begin
//   if Timetostr(Time)=Timetostr(DateTimePicker1.Time) then
//     begin
       showmessage('12341234');
       IF directoryexists(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'月') then
        ELSE mkdir(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'月');
       if directoryexists(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'\'+datetostr(date)) then
       showmessage('12341234')
       else
       begin
        showmessage('111');
        chdir(DirectoryListBox2.Directory+'\'+inttostr(monthof(date))+'月');
        mkdir(datetostr(date));

       end;

end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -