unit Setup;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, FileCtrl, ComCtrls, DdeMan,ShlObj, ComObj,
  ActiveX,Registry;

type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    ProgressBar1: TProgressBar;
    BitBtn3: TBitBtn;
    Label6: TLabel;
    DdeClientConv1: TDdeClientConv;
    DriveComboBox1: TDriveComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    ListBox1: TListBox;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Inputdir, Outputdir,dizin_adi:string;
    filecount:integer;
    function FileCopyExit(inpath,outpath,filename:string; var canclose:boolean):boolean;
  end;

var
  Form1: TForm1;

implementation

uses UCopyFolder;

{$R *.dfm}


//kaynak dizinden(inpath) hedef dizine(outpath) dosyaları kopyalar
function TForm1.FileCopyExit(inpath,outpath,filename:string; var canclose:boolean):boolean;
begin
  result:=true;
  inc(filecount);
  if tag<>0 then result:=false; {user pressed the stop button, abort}
  //memo1.lines.add(format('%s from %s to %s',[filename,inpath,outpath]));
  Application.ProcessMessages;
  ProgressBar1.Position:= filecount;  //kopyalama sürecini progressbarda göster
  Label2.Caption:= filename;          //kopyalanan dosya adını Label2'de göster
  Label2.Refresh;
  Label2.Repaint;
end;


//FindFiles prosedürü,dizin ve alt dizinlerdeki toplam dosya sayısını verir
// Recursive procedure to build a list of files
procedure FindFiles(FilesList: TStringList; StartDir, FileMask: string);
var
  SR: TSearchRec;
  DirList: TStringList;
  IsFound: Boolean;
  i: integer;
begin
  if StartDir[length(StartDir)] <> '\' then
    StartDir := StartDir + '\';

  { Build a list of the files in directory StartDir
     (not the directories!)                         }

  IsFound :=
    FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0;
  while IsFound do begin
    FilesList.Add(StartDir + SR.Name);
    IsFound := FindNext(SR) = 0;
  end;
  FindClose(SR);

  // Build a list of subdirectories
  DirList := TStringList.Create;
  IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0;
  while IsFound do begin
    if ((SR.Attr and faDirectory) <> 0) and
         (SR.Name[1] <> '.') then
      DirList.Add(StartDir + SR.Name);
    IsFound := FindNext(SR) = 0;
  end;
  FindClose(SR);

  // Scan the list of subdirectories
  for i := 0 to DirList.Count - 1 do
    FindFiles(FilesList, DirList[i], FileMask);

  DirList.Free;
end;


//---------KISAYOL OLUŞTUR---------------------------------------------------
//CreateLink('c:\windows\notepad.exe','c:\MyNotePad.lnk','','');
// Desktop, Start Menu ve Quick Launch'da oluştur
//CreateShortCut('Not defteri', 'c:\windows\notepad.exe', 'c:\windows\',[slDesktop, slStartMenu, slQuickLaunch]);

// Sadece Desktop ve Quick Launch'da oluştur
//CreateShortCut('Not defteri', 'c:\windows\notepad.exe', 'c:\windows\',[slDesktop, slQuickLaunch]);

// Sadece Desktop  oluştur
//CreateShortCut('Not defteri', 'c:\windows\notepad.exe', 'c:\windows\',[slDesktop]);

type
    TShortCutLocation = (slDesktop, slStartMenu, slQuickLaunch);
    TShortCutLocations = set of TShortCutLocation;

procedure CreateShortCut(Description, ApplicationPath, StartFolder: string;Locations: TShortCutLocations);
var
    MyObject : IUnknown;
    MySLink : IShellLink;
    MyPFile : IPersistFile;
    Directory : string;
    WFileName : WideString;
    MyReg : TRegIniFile;
begin
    MyObject := CreateComObject(CLSID_ShellLink);
    MySLink := MyObject as IShellLink;
    MyPFile := MyObject as IPersistFile;

    with MySLink do begin
    { Parametreler icin kullanilabilir:
    SetArguments(PChar(Application Path));
    }
    MySLink.SetPath(PChar(ApplicationPath));
    SetRelativePath(PChar(StartFolder),0);
    SetWorkingDirectory(PChar(StartFolder));
    SetDescription(PChar(Description));
    SetIconLocation(PChar(ApplicationPath),0);
    end;
    MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer');

    // Desktop'a kisa yol olusturmak icin }

    if slDesktop in Locations then
    begin
        Directory := MyReg.ReadString('Shell Folders','Desktop','');
        WFileName := Directory+ '\' + Description + '.lnk';
        MyPFile.Save(PWChar(WFileName) ,False);
    end;

    // Start Menu için

    if slStartMenu in Locations then
    begin
        Directory := MyReg.ReadString('Shell Folders','Programs','');

        { Alt Klasörde oluşturmak için:

        Directory = Directory + '\KlasorAdi';
        CreateDir(Directory); }

        WFileName := Directory+ '\' + Description + '.lnk';
        MyPFile.Save(PWChar(WFileName) ,False);
    end;

    // QuickLaunch için

    if slQuickLaunch in Locations then
    begin
        Directory := MyReg.ReadString('Shell Folders','Appdata','');
        WFileName := Directory +'\Microsoft\Internet Explorer\Quick Launch\' +Description + '.lnk';
        MyPFile.Save(PWChar(WFileName) ,False);
    end;
    MyReg.Free;
end;

//unistall programınının yolunu registry e verir
procedure CreateSoftwareEntry(const DisplayName, IconPath, Version, Publisher, UninstallPath: String);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' + DisplayName, true) then
    begin
      Reg.WriteString('DisplayIcon', IconPath);
      Reg.WriteString('DisplayName', DisplayName);
      Reg.WriteString('DisplayVersion', Version);
      Reg.WriteString('Publisher', Publisher);
      Reg.WriteString('UninstallString', UninstallPath);
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;



procedure TForm1.BitBtn1Click(Sender: TObject);
var
    dosya: TextFile;
    satir,str:string;
    FilesList: TStringList;
    file_count:integer;
    Reg:TRegistry;
    GUID:string;

    strGroup    : string;
    strExeName  : string;
    strExeFile  : string;
    strMacro    : string;
    bootdir:string;
begin

    //DriveComboBox1.Drive yüklenecek disk sürücüsü seçilir
    InputDir:=ExtractFilePath(Application.ExeName)+'\Personel Takip';
    OutputDir:=DriveComboBox1.Drive+':\Personel Takip';

    if not DirectoryExists(InputDir) then begin
        Application.MessageBox('Personel Takip Kaynak Yükleme Dizini Bulunamadı...','PROGRAM YÜKLEME HATASI',MB_OK);
        exit;
    end;

    if (Application.MessageBox('Programı Yüklemek İstiyor musunuz...?','UYARI',MB_YESNO)=IDNO) then begin
        exit;
    end;

    if not DirectoryExists(OutputDir) then begin
        CreateDir(OutputDir);
    end else begin
        if (Application.MessageBox('Personel Takip Programı Önceden Yüklenmiş...Devam Etmek İstiyor musunuz...?','UYARI',MB_YESNO)=IDNO) then begin
            exit;
        end;
    end;

    //----kaynak dizin ve alt dizinlerdeki içindeki toplam dosya sayısı---------
    FilesList := TStringList.Create;
    try
        FindFiles(FilesList, InputDir, '*.*');
        ListBox1.Items.Assign(FilesList);
        file_count:=FilesList.Count;
    finally
        FilesList.Free;
    end;
    //--------------------------------------------------------------------------

    ProgressBar1.Min:=0;
    ProgressBar1.Max:=  file_count;
    ProgressBar1.Visible:=true;

    //---kaynak klasör,alt klasör ,dosyaları kopyala---------------------
    tag:=0;
    filecount:=0;
    screen.cursor:=crHourGlass;
    copyfolder(InputDir,OutputDir,'*.*', 0,true,true,FileCopyExit);
    screen.cursor:=crDefault;

    Label2.Caption:='';
    Application.MessageBox('Yükleme Tamamlandı...','Program Yükleme',MB_OK);

    //unistal.exe yi Windows klasörüne kopyala
    //bootdir ile windows'un yüklü olduğu disk sürücüsünü bul
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Setup', false) then
        bootdir:=Reg.ReadString('BootDir');
    Reg.CloseKey;
    Reg.Free;
    CopyFile(PChar(InputDir+'\Uninstall001.exe'),PChar(bootdir+'Windows\Uninstall001.exe'),true);

    //unistal programını registry e kaydet
    CreateSoftwareEntry('Personel Takip', OutputDir+'\Personel.exe', '1.0', 'TAIVAN BSC BIOMETRIC CO. INT.', bootdir+'Windows\Uninstall001.exe');
   
    //başlat->programlarda group oluştur
    strGroup    :=    'Personel Takip';
    strExeName  :=    'Personel';
    strExeFile  :=    OutputDir+'\Personel.exe';

    DdeClientConv1.SetLink('PROGMAN','PROGMAN') ;

    strMacro  :=  '[CreateGroup(' + strGroup  + ')]';
    DDEClientConv1.ExecuteMacro(PChar(strMacro),False);

    //strMacro  :=  '[ShowGroup(' + strGroup  + ',1)]';
    //DDEClientConv1.ExecuteMacro(PChar(strMacro),False);

    strMacro  :=  '[AddItem("' + strExeFile + '","' + strExeName + '")]';
    DDEClientConv1.ExecuteMacro(PChar(strMacro),False);

    if  (Assigned(DDEClientConv1))  then  begin
      DDEClientConv1.CloseLink;
    end;

    //Desktop a kısayol oluştur
    if FileExists(OutputDir+'\Personel.exe')  then
        CreateShortCut('Personel Takip', OutputDir+'\Personel.exe', OutputDir,[slDesktop]);

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
    Label2.Caption:='';
    //ProgressBar1.Visible:=false;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
    Close;
end;

unit UCopyFolder;
{Copyright © 2006, Gary Darby,  www.DelphiForFun.org
 This program may be used or modified for any non-commercial purpose
 so long as this original notice remains in place.
 All other rights are reserved
 }

{CopyFolder procedure copies files matching a given mask from one folder to
 another.  Parameters are;
 FromFolder:  Tha path to the folder containing the files to be copied
 ToFolder:    The path to the folder to receiver the files
 Mask: A file mask to cntol which files are selected ('*.* = All files)
 DupFileOpts:  Four options are available when the file already exists:
             1  ==> skip the file
             2   ==> always copy the file
             3   ==> copy the file if it is newer than the exitising copy
             4   ==> ask the user what actoion to take
 CopySubFolders: Files in subfolders of the specified Inopath folder will also be
                 copied if this parameter is true.
 ResetreadOnly:  If input files marked as "Readonly" will have that attribute
                 removed in the target location.
 FileExit:  The address of optional method (function of object) specifying a
            user procedure to be called before each file is copied.

            If the callback procedure is specified, it receives 4 parameters:
            Inpath: Path to the input file.
            OutputPath: path where the fle will be copied.
            Filename:  Name of the file to be copied.
            Cancopy: Boolean parameter defaulting to true. Set "Cancopy" to
                     false to skip copying this file.

            The FileExit function must return true if copying is to continmue,
            and false to abort the copy procedure without copying further files.

 }


interface

Uses windows,sysutils,dialogs,controls, forms, filectrl,masks;

type
  TCopyFolderExit = function(inpath,outpath,filename:string;
                             var Cancopy:boolean):boolean of object;


  function copyfolder(fromfolderIn, tofolderIn,mask:string; dupfileopts:integer;
                        copysubfolders, ResetReadOnly:boolean):boolean;  overload;

  function copyfolder(fromfolderIn, tofolderIn,mask:string; dupfileopts:integer;
                        copysubfolders, ResetReadOnly:boolean;
                        FileExit:TCopyFolderExit):boolean;  overload;

implementation

{Define a  Dummyclass to hold a dummfileexit method to provide a way for
 the overloaded CopyFolder version without the file exit to pass this
 function as a parameter to the overloaded verion that does the work}
type Tdummyclass = class(TObject)
  function dummyfileexit(inpath,outpath,filename:string;
                             var Cancopy:boolean):boolean;
end;
{Dummy class to provide a instance of the dummyFileExit method required for the
 overloaded version of CopyFolder}
var  dummyclass:TDummyclass;

function Tdummyclass.dummyfileexit(inpath,outpath,filename:string;
                             var Cancopy:boolean):boolean;
begin  {code doesntl matter since it will never be called}
  result:=true;
end;



{*********** CopyFolder ***********}
function copyfolder(fromfolderIn, tofolderIn,mask:string; dupfileopts:integer;
               copysubfolders, ResetReadOnly:boolean;
               FileExit:TCopyFolderExit):boolean; overload;
{Copy files in "fromfolder" to "tofolder", creating tofolder if necessary.
  If file exists in "tofolder" then  action depends on value of "sync" parameter.
  If "sync" is false, always copy,  replacing existing file if necessary, if
  "sync" is true, copy file if it does  not exist in  "tofolder" or it exists
  in "tofolder" with an older date. }
var
  f:TSearchrec;
  r:integer;
  mr:integer;
  fromname,toname:string;
  fromfolder,tofolder:string;
  fromdate,todate:TDatetime;
  //cancopy:boolean;

    {----------- CopyAFile ----------}
    procedure copyafile(FailExists:boolean);
    var cancopy:boolean;
    begin
      cancopy:=true;
      {This is just a substitute for "nil" testing for a
       normal function (not a methof type function}
      if @fileExit<>@tdummyclass.dummyfileexit {nil}
      then result:=fileExit(fromfolder,tofolder,f.name,cancopy);
      if cancopy then
      begin
        copyfile(pchar(fromname),pchar(toname),FailExists);
        if resetreadonly and ((f.attr and faReadOnly)<>0)
        then filesetattr(toname, f.attr and (not FAReadonly));
      end;
    end;

begin
  result:=TRUE;  {default}
  fromfolder:=includeTrailingBackslash(fromfolderIn);
  tofolder:=includeTrailingBackslash(tofolderIn);
  if not directoryexists(tofolder)
  then
  if not createdir(tofolder) then
  begin
    raise Exception.Create('Cannot create '+tofolder);
    result:=false;
  end;
  if result then
  begin
    r:= FindFirst(fromfolder+'*.*', FaAnyFile, F);
    while (r=0) and result do
    begin
      If (length(f.name)>0) and (Uppercase(F.name)<>'RECYCLED')
      and (F.name[1]<>'.') and (F.Attr and FAVolumeId=0)
      then
      begin
        if ((F.Attr and FADirectory) >0) {get files from the next lower level}
        then
        begin
          if copysubfolders
          then result:=Copyfolder(fromfolder+F.Name+'\',
                                  tofolder+f.name+'\', mask,
                                  dupfileopts, copysubfolders, resetreadonly,FileExit)
        end
        else
        try
          if matchesmask(f.name,mask) then
          begin
            fromname:=fromfolder+f.name;
            toname:=tofolder+f.name;
            if fileexists(toname) then
            begin
              todate:=filedatetodatetime(fileage(toname));
              fromdate:=filedatetodatetime(f.time);
              case
                dupfileopts of
                1:{replace}
                  copyafile(false); {(pchar(fromname),pchar(toname),true);  }
                2:{replace if newer}
                begin
                  if todate>fromdate then copyafile(false){(pchar(fromname),pchar(toname),true)}
                end;
                3: {ask}
                begin
                  mr:= messagedlg('Replace '+toname +' created '
                      +formatdatetime(shortdateformat +' '+shorttimeformat,todate)
                      +#13+ 'with '+fromname+' created '
                      +FORMATDATETIME(SHORTDATEFORMAT +' '+SHORTTIMEFORMAT,FROMDATE),
                      mtconfirmation, [mbyes,mbno,mbcancel],0);
                   if mr=mryes then copyafile(false) {(pchar(fromname),pchar(toname),true) }
                   else if mr= mrcancel then result:=false;
                end;
              end; {case}
            end  {fileexists}
            else copyafile(false);
          end;{matchesmask}
        except
          showmessage('Invalid mask "'+mask+'" entered, see documentation');
          result:=false;
        end; {try}
      end;
      r:=Findnext(F);
    end;
    FindClose(f);
  end;
end;

{************** CopyFolder (w/o Callback  ***********8}
function copyfolder(fromfolderIn, tofolderIn,mask:string; dupfileopts:integer;
               copysubfolders, ResetReadOnly:boolean):boolean; overload;
{Copyfolder version w/o callback call to fileExit, call a "do nothing" version}
begin
  result := copyfolder(fromfolderIn, tofolderIn,mask,dupfileopts,
               copysubfolders, ResetReadOnly, dummyclass.DummyFileExit);
end;


//initialization
//  dummyclass:=TDummyClass.create;

end.

unit Uninstall0001;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, DB, ADODB,Shellapi,Registry, DdeMan,StrUtils;

type
  TfrmUnsetup = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    DdeClientConv1: TDdeClientConv;
    Label1: TLabel;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmUnsetup: TfrmUnsetup;

implementation

{$R *.dfm}

//programın yüklü olduğu dizini sil
//Uses Shellapi;
function dizinsil(FilesOrDir: string): boolean;
var
  F: TSHFileOpStruct;
  From: string;
  Resultval: integer;
begin
  FillChar(F, SizeOf(F), #0);
  From := FilesOrDir + #0;
  Screen.Cursor := crHourGlass;
  try
    F.wnd   := 0;
    F.wFunc := FO_DELETE;
    F.pFrom := PChar(From);
    F.pTo   := nil;

    F.fFlags := FOF_ALLOWUNDO or
                FOF_NOCONFIRMATION or
                FOF_SIMPLEPROGRESS or
                FOF_FILESONLY;

    F.fAnyOperationsAborted := False;
    F.hNameMappings := nil;
    Resultval := ShFileOperation(F);
    Result := (ResultVal = 0);
  finally
    Screen.Cursor := crDefault;
  end;
end;

//unistall program exe sini sil
procedure DeleteEXE;

  function GetTmpDir: string;
  var
    pc: PChar;
  begin
    pc := StrAlloc(MAX_PATH + 1);
    GetTempPath(MAX_PATH, pc);
    Result := string(pc);
    StrDispose(pc);
  end;

  function GetTmpFileName(ext: string): string;
  var
    pc: PChar;
  begin
    pc := StrAlloc(MAX_PATH + 1);
    GetTempFileName(PChar(GetTmpDir), 'uis', 0, pc);
    Result := string(pc);
    Result := ChangeFileExt(Result, ext);
    StrDispose(pc);
  end;

var
  batchfile: TStringList;
  batchname: string;
begin
  batchname := GetTmpFileName('.bat');
  FileSetAttr(ParamStr(0), 0);
  batchfile := TStringList.Create;
  with batchfile do
  begin
    try
      Add(':Label1');
      Add('del "' + ParamStr(0) + '"');
      Add('if Exist "' + ParamStr(0) + '" goto Label1');
      Add('rmdir "' + ExtractFilePath(ParamStr(0)) + '"');
      Add('del ' + batchname);
      SaveToFile(batchname);
      ChDir(GetTmpDir);
      Application.MessageBox('Program Kaldırıldı....','Uninstalling program.',MB_OK);
      WinExec(PChar(batchname), SW_HIDE);
    finally
      batchfile.Free;
    end;
    Halt;
  end;
end;

procedure TfrmUnsetup.BitBtn1Click(Sender: TObject);
var
    Reg: TRegistry;
    grup,str:string;

    strGroup    : string;
    strExeName  : string;
    strExeFile  : string;
    strMacro    : string;

    p1:pchar;
    ProgTitel:string;
begin
    if Application.MessageBox('Programı Kaldırmak İstiyor musunuz....?','UYARI',MB_YESNO)=ID_NO then
        exit;

    try
        //registry de DisplayIcon anahtarından programın adını al
        Reg := TRegistry.Create;
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        if Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Personel Takip', false) then
            grup:=LeftStr(Reg.ReadString('DisplayIcon'),13);
        Reg.CloseKey;
        Reg.Free;

        //unistal programının registry kaydını sil
        Reg := TRegistry.Create;
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        if Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall', false) then
            Reg.DeleteKey('Personel Takip');
        Reg.CloseKey;
        Reg.Free;

        //başlat->programlar grubunu kaldır
        strGroup    :=    grup;
        strExeName  :=    'Personel';
        strExeFile  :=    grup+'\Personel.exe';

        DdeClientConv1.SetLink('PROGMAN','PROGMAN') ;
        strMacro  :=  '[DeleteItem("' + strExeFile + '","' + strExeName + '")]';
        DDEClientConv1.ExecuteMacro(PChar(strMacro),False);
        if  (Assigned(DDEClientConv1))  then
            DDEClientConv1.CloseLink;

        //programı sil
        dizinsil(grup);

        //exe kendini silsin
        DeleteEXE;
    except
        Application.MessageBox('Program Kaldırılamadı....','HATA',MB_OK);
    end;
end;



procedure TfrmUnsetup.BitBtn2Click(Sender: TObject);
begin
    Close;
end;

end.