Delphi关联文件扩展名
unit unitMain;
interface
uses
Registry, shlobj,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TExtForm = class(TForm)
ledExtension: TLabeledEdit;
ledAssocApp: TLabeledEdit;
GetAssocApp: TButton;
AssocThisButton: TButton;
procedure FormCreate(Sender: TObject);
procedure AssocThisButtonClick(Sender: TObject);
procedure GetAssocAppClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
ExtForm: TExtForm;
implementation
{$R *.dfm}
function GetExeByExtension(sExt : string) : string;
var
sExtDesc:string;
begin
with TRegistry.Create do
begin
try
RootKey:=HKEY_CLASSES_ROOT;
if OpenKeyReadOnly(sExt) then
begin
sExtDesc:=ReadString('') ;
CloseKey;
end;
if sExtDesc <>'' then
begin
if OpenKeyReadOnly(sExtDesc + '\Shell\Open\Command') then
begin
Result:= ReadString('') ;
end
end;
finally
Free;
end;
end;
if Result <> '' then
begin
if Result[1] = '"' then
begin
Result:=Copy(Result,2,-1 + Pos('"',Copy(Result,2,MaxINt))) ;
end
end;
end;
procedure RegisterFileType(ExtName:String; AppName:String) ;
var
reg:TRegistry;
begin
reg := TRegistry.Create;
try
reg.RootKey:=HKEY_CLASSES_ROOT;
reg.OpenKey('.' + ExtName, True) ;
reg.WriteString('', ExtName + 'file') ;
reg.CloseKey;
reg.CreateKey(ExtName + 'file') ;
reg.OpenKey(ExtName + 'file\DefaultIcon', True) ;
reg.WriteString('', AppName + ',0') ;
reg.CloseKey;
reg.OpenKey(ExtName + 'file\shell\open\command', True) ;
reg.WriteString('',AppName+' "%1"') ;
reg.CloseKey;
finally
reg.Free;
end;
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil) ;
end;
procedure TExtForm.FormCreate(Se
相关文档:
原来是要在FormCreate中加入以下代码:
procedure TTntForm1.TntFormCreate(Sender: TObject);
begin
//这句很关键.对于平台的支持.
if Win32Platform = VER_PLATFORM_WIN32_NT then
Font.Name := 'MS Shell Dlg 2'
else
Font.Name := 'MS Shell Dlg';
......
URL: http://edn.embarcadero.com/article/27568
Abstract: Delphi 6 introduces support for COM+ object pooling, which can provide significant performance improvements under some circumstances. We take a look at Delphi 6s object pooling support. By Vincent Parrett.
Typically, when a client appl ......
//参考地址:http://www.wangchao.net.cn/bbsdetail_41190.html
一、微软RegExp
1. 下载并安装最新版的"Microsoft(r) Windows(r) Script"
2. RegExp包含在vbscript.dll中所以我们必须先注册regsvr32 vbscript.dll
注(安装了Ie5后默认已经包含该控件)
3.在Delph ......
function GetFileSizeString(const pFileName: String):String;
var
iFileSize: Int64;
begin
Result := '0';
iFileSize := FileSizeByName(pFileName);
Result := IntToStr(iFileSize);
end;
function WinExecAndWait(strFileName: string; uCmdShow: UINT): DWORD;
var
cAppName: array ......
unit DvsLinkingClass;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs;
type
PRecLinkNode = ^RecLinkNode;
RecLinkNode = record
NodeMsg: String;
Counter: Integer;
Previous: PRecLinkNode;
Next: PRecLinkNode;
end;
TLinkingClass = class
......