PureBoard

Code: Alles auswählen

;erstellen einer Verknüpfungs Datei (.LNK)
;in PureBasic (Topos)
;peterlorenzkadow@compuserve.de

Ldll5$ = "vb5stkit.dll"
Ldll6$ = "vb6stkit.dll"

 sParent.s="" ;nur bei vb6stkit.dll notwendig
 fPrivate.l=0 ;nur bei vb6stkit.dll notwendig
 lpstrFolderName.s = "C:\" ;Link hier erstellen
 lpstsLinkName.s = "Install.lnk" ;Linkname
 lpstrLinkPath.s = "C:\BASIC\Install.EXE" ;zu verlinkende Datei
 lpstrLinkArguments.s = "" ;Argumente


Result = OpenLibrary(1, Ldll5$) ;.dll vb5stkit.dll öffnen
If Result=0
 Result = OpenLibrary(1, Ldll6$) ;.dll vb6stkit.dll öffnen
 If Result = 0
  Goto enddll
 Else 
  crfunk = IsFunction(1, "fCreateShellLink") ;prüfen an welcher Position Funktion vorhanden ist
  MessageRequester("Meldung",Ldll6$+" gefunden! "+Chr(10)+"Die Schnellzugriffs- Adresse lautet "+Str(crfunk),0)
  ;jetzt wird die Funktion zum erstellen des Link aufgerufen!
  ;Die Parameter sollen folgendes Format haben:
  ;(STRING,STRING,STRING,STRING,LONG,STRING)AS LONG
  ;Haben sie aber nicht! Wie bekomme ich das nur hin?
  Result = CallFunction(1,"fCreateShellLink",lpstrFolderName,lpstsLinkName,lpstrLinkPath,lpstrLinkArguments,fPrivate,sParent)
  ;Der Schnellzugriff würde wie folgt lauten:
  ;Result = CallFunctionFast(crfunk,lpstrFolderName,lpstsLinkName,lpstrLinkPath,lpstrLinkArguments,fPrivate,sParent)
  MessageRequester("Ergebnis","Die Funktion <fCreateShellLink> meldet: "+Str(Result),0)
  If Result = 0
   MessageRequester("Fehler","Funktionsaufruf fehlgeschlagen! ",0)
  EndIf 
 EndIf
Else 
 crfunk = IsFunction(1, "fCreateShellLink")
 MessageRequester("Meldung",Ldll5$+" gefunden! "+Chr(10)+"Die Schnellzugriffs- Adresse lautet "+Str(crfunk),0)
 ;jetzt wird die Funktion zum erstellen des Link aufgerufen!
 ;Die Parameter sollen folgendes Format haben:
 ;(STRING,STRING,STRING,STRING)AS LONG
 ;Haben sie aber nicht! Wie bekomme ich das nur hin?
 Result = CallFunction(1,"fCreateShellLink",lpstrFolderName,lpstsLinkName,lpstrLinkPath,lpstrLinkArguments)
 MessageRequester("Ergebnis","Die Funktion <fCreateShellLink> meldet: "+Str(Result),0)
 If Result = 0
  MessageRequester("Fehler","Funktionsaufruf fehlgeschlagen! ",0)
 EndIf 
EndIf
;----------------------------------------------------------------------------------------

dlfunk = IsFunction(1, "fRemoveShellLink") ;ermitteln der Zugrifsadresse der Funktion Link entfernen
If dlfunk =0
 MessageRequester("Fehler","Funktion Link entfernen <fRemoveShellLink> nicht gefunden!",0)
Else 
 MessageRequester("Meldung","Funktion Link entfernen <fRemoveShellLink> ist vorhanden an Adresse: "+Str(dlfunk),0)
 ;Aufruf der Funktion LINK ENTFERNEN
 ;auch hier der selbe Fehler (String,Sring).l
 Result = CallFunction(1,"fRemoveShellLink",lpstrFolderName,lpstsLinkName)
 ;Der Schnellzugriff würde wie folgt lauten:
 ;Result = CallFunctionFast(dlfunk,lpstrFolderName,lpstsLinkName)  ? mit bekannten Fehler
 MessageRequester("Fehler?","Der Aufruf der Funktion <fRemoveShellLink> meldet "+Str(Result)+" Warum ?",0)
EndIf  
CloseLibrary(1)
enddll:
End 

Code: Alles auswählen

Procedure.l CreateShellLink(strFolderName.s, strLinkName.s, strLinkPath.s, strLinkArguments.s)
  DLL = OpenLibrary(#PB_Any, "vb5stkit.dll")
  If DLL
    Result.l = CallFunction(DLL, "fCreateShellLink", @strFolderName, @strLinkName, @strLinkPath, @strLinkArguments)
    CloseLibrary(DLL)
  EndIf
  ProcedureReturn  Result
EndProcedure