unit1.pas

DELPHI 编写的一个可以调整PSP游戏顺序的小软件!

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, FileCtrl, RzShellDialogs, dxSkinsCore,
  dxSkinsDefaultPainters, cxControls, cxContainer, cxEdit, cxGroupBox,
  cxTextEdit, cxMaskEdit, cxSpinEdit, cxTimeEdit;



type
  TFileTimeType = (fttCreation, fttLastAccess, fttLastWrite);
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    edt1: TEdit;
    edt2: TEdit;
    edt3: TEdit;
    lbl2: TLabel;
    lbl3: TLabel;
    Label2: TLabel;
    RzSelectFolderDialog1: TRzSelectFolderDialog;
    cxgrpbx1: TcxGroupBox;
    cxgrpbx2: TcxGroupBox;
    DateTimePicker1: TDateTimePicker;
    Label1: TLabel;
    Edit1: TEdit;
    Button5: TButton;
    ListBox1: TListBox;
    cxgrpbx3: TcxGroupBox;
    Button1: TButton;
    Button3: TButton;
    Button4: TButton;
    cxTimeEdit1: TcxTimeEdit;
    Button2: TButton;
    Button6: TButton;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ListBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure searchpathDIR(P_dir:string;P_b:Boolean);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
   FileList: TStringList;
   ipos:integer;
   strList:TStringList;


  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetFileDateTime(const FileName: string; FileTimeType: TFileTimeType): TDateTime;
var     
 Handle: THandle; 
 FindData: TWin32FindData; 
 LocalFileTime: TFileTime; 
 DosDateTime: Integer; 
begin 
 Handle := FindFirstFile(PChar(FileName), FindData); 
 if Handle <> INVALID_HANDLE_VALUE then 
 begin 
   Windows.FindClose(Handle); 
   if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then 
   begin 
     case FileTimeType of 
     fttCreation: 
       FileTimeToLocalFileTime(FindData.ftCreationTime, LocalFileTime); 
     fttLastAccess: 
       FileTimeToLocalFileTime(FindData.ftLastAccessTime, LocalFileTime); 
     fttLastWrite: 
       FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); 
     end; 
     if FileTimeToDosDateTime(LocalFileTime, LongRec(DosDateTime).Hi, 
       LongRec(DosDateTime).Lo) then 
     begin 
       Result := FileDateToDateTime(DosDateTime); 
       Exit; 
     end; 
   end; 
 end; 
 Result := -1; 

end; 

function SetFileDateTime(const FileName: string; FileTimeType: TFileTimeType; DateTime: TDateTime): Integer;
var 
 Handle: THandle; 
 LocalFileTime, FileTime: TFileTime; 
 DosDateTime: Integer; 
 I : TFileTimeType; 
 FileTimes: array[TFileTimeType] of Pointer; 
begin 
 Result := 0; 
 DosDateTime := DateTimeToFileDate(DateTime); 
 Handle := FileOpen(FileName, fmOpenWrite or fmShareDenyNone); 
// if Handle <> INVALID_HANDLE_VALUE then
 if True then
 begin
   for I := fttCreation to fttLastWrite do
     FileTimes[I] := nil;
   DosDateTimeToFileTime(LongRec(DosDateTime).Hi, LongRec(DosDateTime).Lo, LocalFileTime);
   LocalFileTimeToFileTime(LocalFileTime, FileTime);
   FileTimes[FileTimeType] := @FileTime;
   if SetFileTime(Handle, FileTimes[fttCreation], FileTimes[fttLastAccess],
     FileTimes[fttLastWrite]) then Exit;
 end; 
 Result := GetLastError;

end;

//使用：
//1、获取文件创建时间：
//  ShowMessage(DateTimeToStr(GetFileDateTime('c:\key.txt',fttLastWrite)));
//2、设置文件修改时间：
//  SetFileDateTime('c:\key.txt',fttLastWrite, datetimepicker1.DateTime);


function NT_SetDateTime(FileName: string; dtCreation, dtLastAccessTime, dtLastWriteTime: TDateTime): Boolean;
  //   by   Nicholas   Robinson
var
  hDir: THandle;
  ftCreation: TFiletime;
  ftLastAccessTime: TFiletime;
  ftLastWriteTime: TFiletime;

  function DTtoFT(dt: TDateTime): TFiletime;
  var
    dwft: DWORD;
    ft: TFiletime;
  begin
    dwft := DateTimeToFileDate(dt);
    DosDateTimeToFileTime(LongRec(dwft).Hi, LongRec(dwft).Lo, ft);
    LocalFileTimeToFileTime(ft, Result);
  end;

begin
  hDir := CreateFile(PChar(FileName),
    GENERIC_READ or GENERIC_WRITE,
    0,
    nil,
    OPEN_EXISTING,
    FILE_FLAG_BACKUP_SEMANTICS,
    0);
  if hDir <> INVALID_HANDLE_VALUE then
    begin
      try
        ftCreation := DTtoFT(dtCreation);
        ftLastAccessTime := DTtoFT(dtLastAccessTime);
        ftLastWriteTime := DTtoFT(dtLastWriteTime);
        Result := SetFileTime(hDir, @ftCreation, @ftLastAccessTime, @ftLastWriteTime);
      finally
        CloseHandle(hDir);
      end;
    end
  else
    Result := False;
end;


procedure TForm1.Button2Click(Sender: TObject);
var
  I: Integer;
begin
  ListBox1.Items.SaveToFile('c:\PSP_GAME.txt');
  ListBox1.Items.LoadFromFile('c:\PSP_GAME.txt');
  for I := 0 to ListBox1.Items.Count - 1 do begin
    ShowMessage(ListBox1.Items.Strings[i])
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 if Form1.Height>=490 then
    Form1.Height :=400
 else
    Form1.Height:=490;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  I: Integer;
  D_time:TDateTime;
begin
  ListBox1.Items.SaveToFile('c:\PSP_GAME.txt');
  ListBox1.Items.LoadFromFile('c:\PSP_GAME.txt');
  for I := 0 to ListBox1.Items.Count - 1 do begin
    D_time:=now-i;
    NT_SetDateTime(ListBox1.Items.Strings[i],D_time,D_time,D_time);
  end;

  ShowMessage('哈哈!PSP的游戏顺序已调整完成!');
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  if RzSelectFolderDialog1.Execute then
     Edit1.Text:= RzSelectFolderDialog1.SelectedPathName
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  sr:TSearchRec;
  fr,i:Integer;
  path, ToPath: string;
  FName : string;
  FileList:TStringList;
begin
  Path:= 'c:\a\*';
  fr:=FindFirst(Path,faAnyFile ,sr);
  FileList:=TStringList.Create;
  while fr=0 do
  begin
    FName := IntToHex(sr.Time,8)+ sr.Name;
    FileList.Add(FName);
    fr:=FindNext(sr);
  end;
  FileList.Sort;

  for i:=FileList.Count-1 downto 0 do   //从大到小排序
  //for i:=0 to FileList.Count-1 do    //从小到大排序
  //Memo1.Lines.Add(copy(FileList[i], 9, MaxInt));

  FindClose(sr);
  FileList.Free;
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  DeleteFile(Pchar('c:\PSP_GAME.txt'));
end;

procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (ListBox1.ItemIndex=-1) then Exit;
  ListBox1.Tag := 1;
  ipos := ListBox1.ItemIndex;
end;

procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  TmpStr: String;
begin
  with ListBox1, ListBox1.Items do
    begin
    if Tag = 0 then Exit;
    if ItemIndex=ipos then Exit;
    TmpStr := Strings[ipos];
    Strings[ipos] := Strings[ItemIndex];
    Strings[ItemIndex] := TmpStr;
    ipos := ItemIndex;
    end;
end;

procedure TForm1.ListBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ListBox1.Tag := 0;
  ListBox1.Update;
end;


procedure TForm1.searchpathDIR(P_dir:string;P_b:Boolean);
var
  i:Integer;
  SearchRec: TSearchRec;
  iResultVal:integer;
  strList1:TStringList;
begin
  strList  := TStringList.Create;
  strList1 := TStringList.Create;
  iResultVal := FindFirst(P_dir,faAnyFile, SearchRec);
  try
    while iResultVal = 0 do
    begin
      if (searchrec.name<>'.') and (searchrec.name<>'..') then
         if p_b=False then begin
            if (searchrec.Attr<>faDirectory) then begin
              strList.Add(IntToHex(SearchRec.Time,8)+Copy(P_dir,1,Length(P_dir) - 1)+SearchRec.Name);
              //ListBox1.Items.Add(IntToHex(SearchRec.Time,8)+Copy(P_dir,1,Length(P_dir) - 1)+SearchRec.Name);
              end
            end
         else begin
            if (searchrec.Attr=faDirectory) then begin
              strList.Add(IntToHex(SearchRec.Time,8)+Copy(P_dir,1,Length(P_dir) - 1)+SearchRec.Name);
              //ListBox1.Items.Add(IntToHex(SearchRec.Time,8)+Copy(P_dir,1,Length(P_dir) - 1)+SearchRec.Name);
              end
            else  begin
              strList1.Add(IntToHex(SearchRec.Time,8)+Copy(P_dir,1,Length(P_dir) - 1)+SearchRec.Name);
              //ListBox1.Items.Add(IntToHex(SearchRec.Time,8)+Copy(P_dir,1,Length(P_dir) - 1)+SearchRec.Name);
            end
         end;
      iResultVal := FindNext(SearchRec);
    end;
  finally
    FindClose(SearchRec);
  end;

  strList.Sort;

  for i:=strList.Count-1 downto 0 do   //从大到小排序
  //for i:=0 to FileList.Count-1 do    //从小到大排序
    ListBox1.items.Add(copy(strList[i], 9, MaxInt));

  //ShowMessage(strList.Text);
  //ShowMessage(strList1.Text);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Clear;

  if Edit1.Text<>'' then begin
    searchpathDIR(Edit1.text+'ISO\*',false);
    searchpathDIR(Edit1.text+edt1.Text+'*',True);
    searchpathDIR(Edit1.text+edt2.Text+'*',True);
    searchpathDIR(Edit1.text+edt3.Text+'*',True);
    end
  else begin
    Button5.Click;
    searchpathDIR(Edit1.text+'ISO\*',false);
    searchpathDIR(Edit1.text+edt1.Text+'*',True);
    searchpathDIR(Edit1.text+edt2.Text+'*',True);
    searchpathDIR(Edit1.text+edt3.Text+'*',True);
    end;
end;

end.