Subversion Repositories delphiutils

Rev

Rev 5 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit FileExtChMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Dialogs, SysUtils, Forms, Classes, Controls, StdCtrls;
  7.  
  8. type
  9.   TForm1 = class(TForm)
  10.     Edit1: TEdit;
  11.     Label1: TLabel;
  12.     Button1: TButton;
  13.     Button2: TButton;
  14.     procedure FormShow(Sender: TObject);
  15.     procedure Button2Click(Sender: TObject);
  16.     procedure Button1Click(Sender: TObject);
  17.   private
  18.     f, e: string;
  19.   protected
  20.     function GetChoosenExt: string;
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. uses
  29.   DropFiles, ShellAPI;
  30.  
  31. {$R *.dfm}
  32.  
  33. resourcestring
  34.   lng_file_not_found = 'The file "%s" was not found!';
  35.   lng_is_a_dir = 'A directory has no filename extension which could be changed.';
  36.  
  37. function RemoveFileNameExt(fn: string): string;
  38. begin
  39.   result := Copy(fn, 1, Length(fn)-Length(ExtractFileExt(fn)));
  40. end;
  41.  
  42. procedure TForm1.FormShow(Sender: TObject);
  43. resourcestring
  44.   lng_syntax = 'Syntax: %s filename';
  45. var
  46.   i: integer;
  47.   nf: string;
  48. begin
  49.   if ParamCount() < 1 then
  50.   begin
  51.     // ShowMessageFmt(lng_syntax, [ExtractFileName(Application.ExeName)]);
  52.     Form2.SetMsg(Format(lng_syntax, [ExtractFileName(Application.ExeName)]));
  53.     Form2.SetCap(Caption);
  54.     Form2.ShowModal;
  55.     Close;
  56.     Exit;
  57.   end;
  58.  
  59.   f := ParamStr(1);
  60.   e := ExtractFileExt(f);
  61.  
  62.   if DirectoryExists(f) then
  63.   begin
  64.     ShowMessage(lng_is_a_dir);
  65.     Close;
  66.     Exit;
  67.   end;
  68.  
  69.   if not FileExists(f) then
  70.   begin
  71.     ShowMessageFmt(lng_file_not_found, [f]);
  72.     Close;
  73.     Exit;
  74.   end;
  75.  
  76.   if ParamCount() > 1 then
  77.   begin
  78.     for i := 2 to ParamCount() do
  79.     begin
  80.       nf := ParamStr(i);
  81.  
  82.       ShellExecute(Handle, 'open', PChar('"'+Application.ExeName+'"'),
  83.         PChar('"'+nf+'"'), PChar('"'+ExtractFilePath(Application.ExeName)+'"'), SW_NORMAL);
  84.     end;
  85.   end;
  86.  
  87.   Label1.Caption := ExtractFileName(f);
  88.   Edit1.Text := Copy(e, 2, Length(e)-1);
  89.   Edit1.SetFocus;
  90. end;
  91.  
  92. procedure TForm1.Button2Click(Sender: TObject);
  93. begin
  94.   Close;
  95. end;
  96.  
  97. procedure TForm1.Button1Click(Sender: TObject);
  98. var
  99.   n: string;
  100. resourcestring
  101.   lng_move_error = 'Could not move file "%s" to "%s". Error code: %d.';
  102.   lng_target_already_exists = 'The target file "%s" already exists. Rename not possible.';
  103. begin
  104.   n := RemoveFileNameExt(f)+GetChoosenExt;
  105.  
  106.   if not FileExists(f) then
  107.   begin
  108.     ShowMessageFmt(lng_file_not_found, [f]);
  109.     Close;
  110.     Exit;
  111.   end;
  112.  
  113.   if FileExists(n) then
  114.   begin
  115.     ShowMessageFmt(lng_target_already_exists, [n]);
  116.     Close;
  117.     Exit;
  118.   end;
  119.  
  120.   if not MoveFile(PChar(f), PChar(n)) then
  121.   begin
  122.     ShowMessageFmt(lng_move_error, [f, n, GetLastError()]);
  123.   end;
  124.  
  125.   Close;
  126. end;
  127.  
  128. function TForm1.GetChoosenExt: string;
  129. begin
  130.   if Edit1.Text = '' then
  131.     result := ''
  132.   else
  133.     result := '.'+Edit1.text;
  134. end;
  135.  
  136. end.
  137.