چک کردن آیا برنامه نصب شده یا نه

[neda_barnamenevis]

من یک برنامه نوشتم به ای صورت

unction TmainForm.installFonts():Boolean;
var
fontPath : String;
sWinDir: String;
iLength: Integer;
begin
// finding windows fonts directory
installFonts := True;
iLength := 255;
setLength(sWinDir, iLength);
iLength := GetWindowsDirectory(PChar(sWinDir), iLength);
setLength(sWinDir, iLength);
sWinDir := sWinDir+'\Fonts\';
fontPath := GetCurrentDir()+'\fonts\';
if (CopyFile(pChar(fontPath+'F_MARYAM.TTF'),PChar(sWi nDir+'F_MARYAM.TTF'),False)then
installFonts := True
else
installFonts := False;
// ShowMessage('nada');

AddFontResource(PChar(sWinDir+'F_MARYAM.TTF'));
end;





procedure TmainForm.Button1Click(Sender: TObject);
begin
if( not installFonts() ) then
begin
form1.ShowModal;
end;
winexec('aero2007.exe',1);
Application.Terminate;
end;


در هر دوصورت چه فونت نصب شده باشه چه نشده باشه
form1را بهم نشون می ده
لطفا بهم بگین چرا

[Saeid59_m]

اولا توابع بدون پارامتر نیازی به پرانتز خالی ندارند (اون توی سی بود)
دوما چرا تابع رو جزو کلاس Form‌ قراردادی البته خیلی از دوستان این کار رو می کنن . نمی دونم چرا ؟!
سوماً خروجی CopyFile‌ فقط می گه که کار به درستی انجام شده یا نه بهتره از تایع FileExist‌ استفاده کنی .

[neda_barnamenevis]

من الان این جوری چک می کنم ولی مشکل اینه که باید همه فونت ها نباشه تا فونت را نصب کنه اگر 2 تاش بود 2 تاش نبود نصب نمی کنه چرا؟

function TmainForm.checkFontsInstalled():Boolean;
var sWinDir: String;
iLength: Integer;
begin
// Initialize Variable
iLength := 255;
setLength(sWinDir, iLength);
iLength := GetWindowsDirectory(PChar(sWinDir), iLength);
setLength(sWinDir, iLength);
sWinDir := sWinDir+'\Fonts\';
if( fileExists( sWinDir+'F_MARYAM.TTF') and
fileExists( sWinDir+'F_TAHOMA.TTF') and
fileExists( sWinDir+'F_ZAR.TTF') and
fileExists( sWinDir+'F_TITR.TTF') and
fileExists( sWinDir+'NAZ___SF.TTF') and
fileExists( sWinDir+'NAZB__SF.TTF') ) then
checkFontsInstalled := True
else
checkFontsInstalled := False
end;

[Saeid59_m]

به جای


function TmainForm.checkFontsInstalled():Boolean;
var sWinDir: String;
iLength: Integer;
begin
// Initialize Variable
iLength := 255;
setLength(sWinDir, iLength);
iLength := GetWindowsDirectory(PChar(sWinDir), iLength);
setLength(sWinDir, iLength);
sWinDir := sWinDir+'\Fonts\';
if( fileExists( sWinDir+'F_MARYAM.TTF') and
fileExists( sWinDir+'F_TAHOMA.TTF') and
fileExists( sWinDir+'F_ZAR.TTF') and
fileExists( sWinDir+'F_TITR.TTF') and
fileExists( sWinDir+'NAZ___SF.TTF') and
fileExists( sWinDir+'NAZB__SF.TTF') ) then
checkFontsInstalled := True
else
checkFontsInstalled := False
end;

اینو بنویس



function TmainForm.checkFontsInstalled():Boolean;
var sWinDir: String;
iLength: Integer;
begin
// Initialize Variable
iLength := 255;
setLength(sWinDir, iLength);
iLength := GetWindowsDirectory(PChar(sWinDir), iLength);
setLength(sWinDir, iLength);
sWinDir := sWinDir+'\Fonts\';
checkFontsInstalled:=False;

if Not fileExists( sWinDir+'F_MARYAM.TTF') then exit;
if Not fileExists( sWinDir+'F_TAHOMA.TTF') then exit;
if Not fileExists( sWinDir+'F_ZAR.TTF') then exit;
if Not fileExists( sWinDir+'F_TITR.TTF') then exit;
if Not fileExists( sWinDir+'NAZ___SF.TTF') then exit;
if Not fileExists( sWinDir+'NAZB__SF.TTF') Then exit;

checkFontsInstalled:=True;


end;

[SYNDROME]

با سلام
به جای Check کردن فونتها می توانید یک فایل خاص با نام خاص را در پوشه ای کپی کنید که آن فایل نشانگر نصب برنامه شما است.
مثلا یک فایل با نامه Test در شاخه فونت یا System32.(البته یک مثال بود)
موفق باشید.

[SayeyeZohor]

uses
Registry;

FUNCTION IsWOW64: Boolean;
TYPE // Type of IsWow64Process API fn
TIsWow64Process = function(Handle: THandle; var Res: BOOL): BOOL; stdcall;
VAR
IsWow64Result: BOOL; // result from IsWow64Process
IsWow64Process: TIsWow64Process; // IsWow64Process fn reference
BEGIN
// Try to load required function from kernel32
IsWow64Process := GetProcAddress(GetModuleHandle('kernel32'), 'IsWow64Process');
IF Assigned(IsWow64Process) THEN
BEGIN
// Function is implemented: call it
if not IsWow64Process(GetCurrentProcess, IsWow64Result) then
raise Exception.Create('Bad process handle');
// Return result of function
Result := IsWow64Result;
END
ELSE
// Function not implemented: can't be running on Wow64
Result := False;
END;

FUNCTION ProgramInstall(NameProgram: string): Boolean;
var
Reg: TRegistry;
RegKey: String;
Key: String;
BEGIN
Reg := TRegistry.Create;
TRY
Reg.RootKey := HKEY_LOCAL_MACHINE;
Key := 'SOFTWARE\';
IF IsWOW64 THEN Key := Key + 'Wow6432Node\';
Key := Key + 'Microsoft\Windows\CurrentVersion\Uninstall\' + NameProgram;

IF (Reg.OpenKeyReadOnly(Key)) AND (Reg.ValueExists('DisplayName')) THEN
BEGIN
RegKey := Reg.ReadString('DisplayName');
Reg.CloseKey;
Result := True;
END
ELSE
BEGIN
Reg.CloseKey;
Result := False;
END;
FINALLY
Reg.Free
END;
END;