Ce code permet d'ajouter des fonctions dans APIFunctionListing.txt. Quand vous tapez une fonction API suportée par PB, il y a l'aide contextuelle qui s'affiche dans la barre d'état. Ce code permet d'ajouter des aides contextuelles pour des fonctions API normalement non suportées par purebasic, en cas d'une dll ajoutée par DLLImporter.
Voici le code.
Code : Tout sélectionner
; Auteur : Gansta93
; Author: Gansta93
; Date : 28/04/2004
; Date : 20 Apr. 2004
; Version de PureBasic : 3.93
; Explication : Ajouter des fonctions API dans l'aide de la bare d'état
; Explication : Add some API functions for status bar quick help
; Liste chaînée pour mettre les fonctions
; LinkedList to put the functions
NewList APIList.s()
; Variables
DefType.s PBPath
Global PBPath
Global NBAPI
; Procedures
; Récupérer le chemin d'installation de PureBasic
; Par Fred
; Get PureBasic installation path
; By Fred
Procedure.s GetPBFolder()
Shared hKey1, Type
cbData = (#MAX_PATH * 2) + 2
lpbData = AllocateMemory(cbData)
If GetVersion_() & $ff0000 ; Windows NT/XP
If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "Applications\PureBasic.exe\shell\open\command", 0, #KEY_ALL_ACCESS, @hKey1) = #ERROR_SUCCESS
If RegQueryValueEx_(hKey1, "", 0, @Type, lpbData, @cbData) = #ERROR_SUCCESS
Folder$ = PeekS(lpbData)
Folder$ = GetPathPart(Mid(Folder$, 2, Len(Folder$) - 7))
If Right(Folder$, 1) = "\"
Folder$ + "\"
EndIf
EndIf
RegCloseKey_(hKey1)
EndIf
Else ; The same for Win9x
If RegOpenKeyEx_(#HKEY_LOCAL_MACHINE, "Software\Classes\PureBasic.exe\shell\open\command", 0, #KEY_ALL_ACCESS, @hKey1) = #ERROR_SUCCESS
If RegQueryValueEx_(hKey1, "", 0, @Type, lpbData, @cbData) = #ERROR_SUCCESS
Folder$ = PeekS(lpbData)
Folder$ = GetPathPart(Mid(Folder$, 2, Len(Folder$) - 7))
If Right(Folder$, 1) = "\"
Folder$ + "\"
EndIf
EndIf
RegCloseKey_(hKey1)
EndIf
EndIf
FreeMemory(lpbData)
ProcedureReturn Folder$
EndProcedure
; Vérifier si une fonction n'est pas déjà dans le fichier APIFunctionListing.txt
; Check if a function already exists in APIFunctionListing.txt
; Retourne #True si la fonction existe, #False sinon
; Return #True if the function exists, else #False
Procedure CheckFunction(FunctionName.s)
ResetList(APIList())
ForEach APIList()
If APIList() = FunctionName
ProcedureReturn #True
EndIf
Next
ProcedureReturn #False
EndProcedure
; Ajouter une fonction à la liste
; Add a function to the list
Procedure AddFunction(FunctionName.s)
AddElement(APIList())
APIList() = FunctionName
EndProcedure
; Lire et insérer les fonctions dans la liste
; Read and insert functions into the list
; Récupérer le chemin d'installation de PureBasic dans la variable PBPath
; Get PureBasic folder in the variable PBPath
PBPath = GetPBFolder()
Procedure ReadApi()
If ReadFile(0, PBPath + "Compilers\APIFunctionListing.txt")
NBAPI = Val(ReadString())
While Eof(0) = 0
API$ = ReadString()
If API$
AddElement(APIList())
APIList() = API$
EndIf
Wend
CloseFile(0)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
; Trillage des fonctions par ordre alphabétique
; Sort functions alphabetically
Procedure SortFunctions()
ResetList(APIList())
SortStructuredList(APIList(), 2, 0, #PB_Sort_String)
EndProcedure
; écrire les fonctions dans APIFunctionListing.txt
; Write functions into APIFunctionListing.txt
Procedure WriteFunctions()
If CreateFile(0, PBPath + "Compilers\APIFunctionListing.txt")
WriteStringN(Str(CountList(APIList())))
ForEach APIList()
WriteStringN(APIList())
Next
CloseFile(0)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
; Vérification du contenu de APIFunctionListing.txt pour voir si tout est bon
; Check the content of APIFunctionListing.txt to know if all is good
Procedure CheckFile()
If ReadFile(0, PBPath + "Compilers\APIFunctionListing.txt")
ResetList(APIList())
If ReadString() = Str(CountList(APIList()))
ForEach APIList()
If ReadString() <> APIList()
ProcedureReturn #False
Break
EndIf
Next
If Eof(0)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
Else
ProcedureReturn #False
EndIf
Else
ProcedureReturn #False
EndIf
EndProcedure
; Programme principal
; Main program
MessageRequester("Information", "Des fonctions vont êtres ajoutées - some functions are going to be added.")
If ReadAPI() = 0
MessageRequester("Impossible de lire les API", "Unable to read API.")
End
EndIf
If checkfunction("JFWSayString (lpszStrinToSpeak$, bInterrupt)") = 0
AddFunction("JFWSayString (lpszStrinToSpeak$, bInterrupt)")
Else
MessageRequester("Information", "Function JFWSayString() exists.")
EndIf
If CheckFunction("JFWStopSpeech()") = 0
AddFunction("JFWStopSpeech()")
Else
MessageRequester("Info", "Function JFWStopSpeech() exists.")
EndIf
If CheckFunction("JFWRunScript (LPCTSTR lpszScriptName$)") = 0
AddFunction("JFWRunScript (LPCTSTR lpszScriptName$)")
Else
MessageRequester("Information", "Function JFWRunScript() exists.")
EndIf
SortFunctions()
Repeat
If RenameFile(PBPath + "Compilers\APIFunctionListing.txt", PBPath + "Compilers\APIFunctionListing.txt.bak") = 0
If MessageRequester("Impossible de faire la sauvegarde, réessayer ?", "Unable to write the backup file. Retry?", #MB_RetryCancel) = 2
MessageRequester("Sauvegarde non effectuée, fin du programme", "File not saved, end of the program.")
End
End
EndIf
Else
Break
EndIf
ForEver
If WriteFunctions() = 0
MessageRequester("Impossible d'écrire les fonctions", "Unable to write functions.")
End
EndIf
If CheckFile() = 0
MessageRequester("Fichier mal écrit", "Writing error")
DeleteFile(PBPath + "Compilers\APIFunctionListing.txt")
RenameFile(PBPath + "Compilers\APIFunctionListing.txt.bak", "APIFunctionListing.txt")
Else
MessageRequester("Terminé avec succès", "Successfuly done.")
EndIf
End
mais il faut en avoir l'utilité