Mega Code Archive
Dosya tipini windowsa kaydettirmek ve herhangi bir programla acilmasini saglamak
<![CDATA[
//ozgurfidan@email.com tüm sorunlarınız için e mail atabilirsiniz
//www.sevgi.get.to
procedure RegisterExtension(const sExt, sDesc, AppPath: string);
begin
with TRegistry.Create do
try
RootKey := HKEY_CLASSES_ROOT;
if OpenKey(sExt, True) then begin
WriteString('', sDesc);
CloseKey;
end;
if OpenKey('\' + sDesc, True) then begin
WriteString('', sDesc);
CloseKey;
end;
if OpenKey('DefaultIcon', True) then begin
WriteString('', AppPath + ',' + IntToStr(0));
CloseKey;
end;
if OpenKey('\' + sDesc + '\Shell\Open\Command', True) then begin
WriteString('', '"' + AppPath + '" "%1"');
CloseKey;
end;
finally
Free;
end;
end;
// Kullanimi:
procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterExtension('.den', 'Deneme Dosyasi', 'C:\windows\notepad.exe')
end;
Islemcinin üretici firmasini bulmak
function GetVendorString: string;
var
aVendor: array[0..2] of DWord;
iI, iJ : Integer;
begin
asm
push ebx
xor eax, eax
dw $A20F // CPUID instruction
mov DWord ptr aVendor, ebx
mov DWord ptr aVendor[+4], edx
mov DWord ptr aVendor[+8], ecx
pop ebx
end;
for iI := 0 to 2 do
for iJ := 0 to 3 do
Result := Result + Chr((aVendor[iI] and ($000000FF shl (iJ * 8))) shr (iJ * 8));
end;
// Kullanimi:
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.caption := GetVendorString
end;
//ozgurfidan@email.com tüm sorunlarınız için e mail atabilirsiniz
//www.sevgi.get.to
]]>