PureBasic Forums - English

Code: Select all

; kiffi, https://www.purebasic.fr/german/viewtopic.php?f=8&t=28267
; GetProcedureName
; REV: 190606, skywalk
;      Modified to catch similarly named Procedures in ListBox.
;      Ex. ShowIt() and ShowIt2().
; REV: 190607, skywalk
;      Attempt to read process memory instead of temp file.
;      Ex. ShowIt() and ShowIt2().
;#################################################################
; Tool arguments: "%TEMPFILE"
;#################################################################
EnableExplicit
#SP$ = Chr(32)
#TAB$ = Chr(9)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
  #EOL$ = #CRLF$
CompilerDefault
  #EOL$ = #LF$
CompilerEndSelect
Global.s FilePath$
Procedure.s RemoveLeadingWhitespaceFromString(InString$)
  While Left(InString$, 1) = #SP$ Or Left(InString$, 1) = #TAB$
    InString$ = LTrim(InString$, #SP$)
    InString$ = LTrim(InString$, #TAB$)
  Wend
  ProcedureReturn InString$
EndProcedure
Procedure.s GetScintillaText()
  ; sicro, http://www.purebasic.fr/german/viewtopic.php?p=324916#p324916
  Protected.s r$
  Protected File, BOM
  FilePath$ = ProgramParameter(0); %TEMPFILE (file also exists if code is not saved)
  File = ReadFile(#PB_Any, FilePath$, #PB_File_SharedRead)
  If IsFile(File)
    BOM = ReadStringFormat(File)  ; Skip BOM if present
    r$ = ReadString(File, #PB_File_IgnoreEOL); | BOM)
    CloseFile(File)
    If FindString(FilePath$, "\Temp\", 1, #PB_String_NoCase)
      ; Only delete temp file, in case user enters wrong path in Tool options.
      DeleteFile(FilePath$)
    EndIf
  EndIf
  ProcedureReturn r$
EndProcedure
Procedure.i ct_hpID_from_hW(hW.i)
  ;         ct_pID_from_hW
  Protected.i pID, hpID
  If GetWindowThreadProcessId_(hW, @pID)
    hpID = OpenProcess_(#PROCESS_ALL_ACCESS, 0, pID)
  EndIf
  ProcedureReturn hpID
EndProcedure
Procedure.s ct_sci_GetText(hSci.i, hpid.i)
  ; REV:  180218, skywalk
  ; USE:  Get all text in current tab of editor.
  Protected.i ri, Length, Length2, Format
  Protected.i *mSci, *mtxt
  Protected.s txt$
  If hSci And hpid
    Select SendMessage_(hSci, #SCI_GETCODEPAGE, 0, 0)
    Case 0
      Format = #PB_Ascii
    Case 2, 65001
      Format = #PB_UTF8
    EndSelect
    MessageRequester("Format", Str(Format))
    Length = SendMessage_(hSci, #SCI_GETTEXT, 0, 0) + SizeOf(Character)
    MessageRequester("Length", Str(Length))
    MessageRequester("hpid", Str(hpid))
    *mtxt = AllocateMemory(Length+32)
    If *mtxt
      *mSci = VirtualAllocEx_(hpid, 0, Length, #MEM_RESERVE | #MEM_COMMIT, #PAGE_EXECUTE_READWRITE)
      MessageRequester("*mSci", Str(*mSci))
      If *mSci
        SendMessage_(hSci, #SCI_GETTEXT, 0, *mSci)
        ri = ReadProcessMemory_(hpid, *mSci, *mtxt, Length - SizeOf(Character), @Length2)
        MessageRequester("readprocessmemory", Str(ri))
        MessageRequester("length2", Str(length2))
        txt$ = PeekS(*mtxt, Length2, #PB_Ascii)
        Delay(30)
        VirtualFreeEx_(hpid, *mSci, Length, #MEM_RELEASE)
      EndIf
      MessageRequester("txt$", txt$)
      FreeMemory(*mtxt)
    EndIf
  EndIf
  ProcedureReturn txt$
EndProcedure
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  Procedure EnumChildProc(hWnd, *lParam)
    Protected.i Count, i, Size, searchfull
    Protected.s Buffer, Buffer2
    Protected CName.s{128}
    GetClassName_(hWnd, @CName, 128)
    If CName = "ListBox"
      Count = SendMessage_(hWnd, #LB_GETCOUNT, #Null, #Null)
      For i = Count - 1 To 0 Step -1  ; Search bottom up to help search alphabetically.
        Size   = SendMessage_(hWnd, #LB_GETTEXTLEN, i, #Null)
        Buffer = Space(Size + 64)
        If SendMessage_(hWnd, #LB_GETTEXT, i, @Buffer)
          If searchfull = 0
            ; Check if parameters are shown in listview
            If FindString(Buffer, "(")
              searchfull = 1
            Else
              searchfull = -1
            EndIf
          EndIf
          If searchfull = 1
            If PeekS(*lParam) = Buffer
              SendMessage_(hWnd, #LB_SETCURSEL, i, #Null)
              ProcedureReturn 0
            EndIf
          Else
            Buffer2 = Trim(StringField(PeekS(*lParam), 1, "("))
            ;MessageRequester("In EnumChildProc", Buffer + " = " + Buffer2)
            If Buffer2 = Buffer
              SendMessage_(hWnd, #LB_SETCURSEL, i, #Null)
              ProcedureReturn 0
            EndIf
          EndIf
        EndIf
      Next i
    EndIf
    ProcedureReturn 1
  EndProcedure
CompilerEndIf
CompilerIf 0
  Procedure ShowIt2(Line$)
    ; Dummy procedure with nearly same name.
    ; Cursor here did not not select correct Procedure in ListBox.
  EndProcedure
CompilerEndIf
Procedure ShowIt(Line$)
  Protected.i hwnd, i
  Protected.s s$
  CompilerSelect #PB_Compiler_OS
  CompilerCase #PB_OS_Windows
    hwnd = Val(GetEnvironmentVariable("PB_TOOL_MainWindow"))
    i    = FindString(Line$, " ")
    If i = 0
      i = FindString(Line$, #TAB$)
    EndIf
    Line$ = Mid(Line$, i + 1)
    Line$ = RemoveLeadingWhitespaceFromString(Line$)
    ;MessageRequester("SHOWIT", Line$)
    EnumChildWindows_(hWnd, @EnumChildProc(), @Line$)
  CompilerDefault
    ;Linux / Mac?
    MessageRequester("You are here:", Line$)
  CompilerEndSelect
EndProcedure
;-{ START
Define.i i
Define.i CursorLine = Val(StringField(GetEnvironmentVariable("PB_TOOL_Cursor"), 1, "x"))
Define.s ScintillaText$, Line$
If 1
  ScintillaText$ = GetScintillaText()
Else  ;TBD; Get the text from current opened file instead of TEMPFILE.
  Define.i hSci = Val(GetEnvironmentVariable("PB_TOOL_Scintilla"))
  Define.i hIDE = Val(GetEnvironmentVariable("PB_TOOL_MainWindow"))
  Define.i hpid = ct_hpid_from_hW(hSci)
  If hSci And hpid
    ScintillaText$ = ct_sci_GetText(hSci, hpid)
    CloseHandle_(hpid)
  EndIf
EndIf
If ScintillaText$ <> #Empty$
  For i = CursorLine To 1 Step - 1
    Line$ = RemoveLeadingWhitespaceFromString(StringField(ScintillaText$, i, #EOL$))
    ;;MessageRequester("BEFORE SHOWIT", Line$)
    ; Allow EndProcedure to trigger search.
    ;If Left(LCase(Line$), Len("endprocedure")) = "endprocedure"
    ;  Break
    ;EndIf
    If Left(LCase(Line$), Len("procedure")) = "procedure"
      If Left(LCase(Line$), Len("procedurereturn")) <> "procedurereturn"
        ShowIt(Line$)
        Break
      EndIf
    EndIf
  Next i
EndIf
;-} STOP