!==================================================================================
! Класс создания ярлыков.
! Вячеслав Черников, г.Рязань, 2022 г.
!==================================================================================

                     MEMBER

   INCLUDE('fsShortCut.INC')
   INCLUDE('WINEQU.INC')

   MAP
     INCLUDE('BUILTINS.CLW'),ONCE   !функции RTL

     MODULE('WINAPI')
       CreateFile(*CSTRING,ULONG,ULONG,LONG,ULONG,ULONG,UNSIGNED=0),UNSIGNED,RAW,PASCAL,NAME('CreateFileA')
       WriteFile(UNSIGNED,<*?>,ULONG,*ULONG,<*?>),BOOL,PASCAL,RAW,PROC
       CloseHandle(UNSIGNED),BOOL,PASCAL,PROC,NAME('CloseHandle')
     END
   END

!===================================================================================
! Инициализация класса
!
FsShortCut.Init PROCEDURE (STRING FNameScript)
      CODE

   if SELF.Active=1
      return
   end
      
   if FNameScript=''
      return
   end

   if instring('.vbs',FNameScript,1,1)=0
      return
   end      
      
   SELF.FileNameScript=FNameScript   

   SELF.QueueBuf    &=  new(QueueBufSCType)     !создание буфера для скрипта

   SELF.BufPoint    =0
   SELF.BufPointMax = 1024

   SELF.Active=1

!===================================================================================
! Деактивация класса
!
FsShortCut.Kill PROCEDURE
      CODE

   if SELF.Active=0
      return
   end

   free(SELF.QueueBuf)

   dispose(SELF.QueueBuf)

   SELF.Active=0

!===================================================================================
!
! Деструктор класса
!
FsShortCut.Destruct PROCEDURE
   CODE
      SELF.Kill
!===================================================================================
!
! Создать ярлык
!
FsShortCut.Make    PROCEDURE (BYTE pReg, STRING pPrg, STRING pPath, STRING pName, STRING pTitle)
   CODE

      if SELF.Active = 0
         return
      end    
   
      SELF.AddScriptInt('Dim WshShorcut, MyShortCut')
      SELF.AddScriptInt('Set WshShorcut = WScript.CreateObject("WScript.Shell")')
      case pReg
         of 1
            SELF.AddScriptInt('pPath = WshShorcut.SpecialFolders("Desktop")')
         of 2   
            SELF.AddScriptInt('pPath = WshShorcut.SpecialFolders("Startup")')
      end      
      SELF.AddScriptInt('Set MyShortCut=WshShorcut.CreateShortCut(pPath & "\' & clip(pName) & '")')
      SELF.AddScriptInt('MyShortCut.Description="' & clip(pTitle) & '"')
      SELF.AddScriptInt('MyShortCut.TargetPath="' & clip(pPrg) & '"')
      SELF.AddScriptInt('MyShortCut.WorkingDirectory="' & clip(pPath) & '"')
      SELF.AddScriptInt('MyShortCut.WindowStyle=4')
      SELF.AddScriptInt('MyShortCut.IconLocation="' & clip(pPrg) & ', 0"')
      SELF.AddScriptInt('MyShortCut.Save')
      
      SELF.MakeScript
      SELF.RunScript
      

!===================================================================================
!
! Добавить строку в буфер скрипта
!
FsShortCut.AddScriptInt    PROCEDURE (STRING Str)
loc:dl  long
loc:poz long
   CODE

      if SELF.Active = 0
         return
      end    

      loc:dl = len(clip(str))+2
      loc:poz = 0

      if (SELF.BufPoint+loc:dl)<=SELF.BufPointMax   !вся строка помещается в строку буфера
         if SELF.BufPoint=0
            SELF.QueueBuf = clip(str) & CHR(13) & CHR(10)
         else
            SELF.QueueBuf = sub(SELF.QueueBuf,1,SELF.BufPoint) & clip(str) & CHR(13) & CHR(10)
         end
         SELF.BufPoint += loc:dl
         return
      end

      if SELF.BufPoint>0 and (SELF.BufPoint+loc:dl)>=SELF.BufPointMax  !дописываем последнюю строку в кьюшке скрипта
         SELF.QueueBuf = sub(SELF.QueueBuf,1,SELF.BufPoint) & sub(clip(str) & CHR(13) & CHR(10),1,SELF.BufPointMax-SELF.BufPoint)
         add(SELF.QueueBuf)
         loc:poz=SELF.BufPointMax-SELF.BufPoint
         SELF.BufPoint=0
      end

      loop  !вписываем целые части
         if loc:dl-loc:poz<SELF.BufPointMax
            break
         end 
         SELF.QueueBuf = sub(clip(str) & CHR(13) & CHR(10),loc:poz+1,SELF.BufPointMax)
         add(SELF.QueueBuf)
         loc:poz+=SELF.BufPointMax
      end

      if loc:dl-loc:poz>0
         SELF.QueueBuf = sub(clip(str) & CHR(13) & CHR(10),loc:poz+1,loc:dl-loc:poz)
         SELF.BufPoint=loc:dl-loc:poz
      end

!===================================================================================
! Сформировать скрипт
!
FsShortCut.MakeScript PROCEDURE 

loc:LocalFile     CSTRING(255)   !имя локального файла
loc:hLocal        UNSIGNED       !ссылка на локальный файл
loc:BufferLength  ULONG
loc:Buffer        &CSTRING

loc:recs          long
loc:len           long
loc:i             long
loc:err           byte

FILE_ATTRIBUTE_NORMAL  EQUATE(00000080H)

      CODE

      if SELF.Active=0
         return
      end

      loc:len=len(SELF.QueueBuf)
      loc:recs=records(SELF.QueueBuf)

      if loc:recs=0 and SELF.BufPoint=0
         return
      end

      if SELF.BufPoint<>0
         add(SELF.QueueBuf)
      end

      loc:BufferLength = loc:len*loc:recs+SELF.BufPoint+1
      
      if exists(SELF.FileNameScript)
         remove(SELF.FileNameScript)
      end
      
      loc:Buffer &= new(CSTRING(loc:BufferLength))
      loop loc:i=1 to records(SELF.QueueBuf) 
         get(SELF.QueueBuf,loc:i)
         if loc:i=1
            loc:Buffer=SELF.QueueBuf 
         else
            loc:Buffer=sub(loc:Buffer,1,loc:len*(loc:i-1)) & SELF.QueueBuf 
         end
      end

      loc:LocalFile = SELF.FileNameScript     

      loc:hLocal = CreateFile(loc:LocalFile, GENERIC_READ+GENERIC_WRITE, |   !создать ссылку на выходной файл
                            FILE_SHARE_READ + FILE_SHARE_WRITE, 0 ,      |
                            CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL,0)

      if ~WriteFile(loc:hLocal, loc:Buffer, loc:BufferLength, loc:BufferLength)  
         loc:err=1
      else
         loc:err=0 
      end

      CloseHandle(loc:hLocal)  !закрываем выходной файл

      clear(loc:Buffer)
      dispose(loc:Buffer)

      free(SELF.QueueBuf)

      if loc:err=1
         message('Ошибка при сохранении скрипта в файл ' & clip(SELF.FileNameScript))
         return
      end

!===================================================================================
! Выполнить скрипт
!
FsShortCut.RunScript PROCEDURE 
   CODE

      if SELF.Active=0
         return
      end

      if ~exists(SELF.FileNameScript)
         return
      end

      run('wscript ' & clip(SELF.FileNameScript),1)
   
      remove(SELF.FileNameScript)