Turning StrPtr Zeiger wieder auf tatsächliche Zeichenfolge

Question

Verwenden von StrPtr() Ich kann einen Zeiger auf eine Zeichenfolge im Speicher abrufen, aber ich möchte es umkehren und die Zeichenfolge aus einem Zeiger abrufen.

Wie würde dies geschehen?

Vielen Dank!

Da ich in ein Problem mit dem Vorschlag Lösung lief, ich meine gesamte Code veröffentlichen hier jetzt:

Private Declare Function WTSQueryUserToken Lib "Wtsapi32.dll" (ByVal SessionID As Long, ByRef phToken As Long) As Long 

Private Const WTS_CURRENT_SERVER_HANDLE = 0& 

Private Enum WTS_CONNECTSTATE_CLASS 
WTSActive 
WTSConnected 
WTSConnectQuery 
WTSShadow 
WTSDisconnected 
WTSIdle 
WTSListen 
WTSReset 
WTSDown 
WTSInit 
End Enum 

Private Type WTS_SESSION_INFO 
    SessionID As Long 
    pWinStationName As Long 
    state As WTS_CONNECTSTATE_CLASS 
End Type 

Private Declare Function WTSEnumerateSessions _ 
Lib "Wtsapi32.dll" Alias "WTSEnumerateSessionsA" (_ 
ByVal hServer As Long, ByVal Reserved As Long, _ 
ByVal Version As Long, ByRef ppSessionInfo As Long, _ 
ByRef pCount As Long _ 
) As Long 

Private Declare Sub WTSFreeMemory Lib "Wtsapi32.dll" (_ 
ByVal pMemory As Long) 

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (_ 
Destination As Any, Source As Any, ByVal length As Long) 

Private Declare Function lstrlenA Lib "kernel32" (_ 
ByVal lpString As String) As Long 

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (_ 
ByVal lpString1 As String, ByVal lpString2 As Long) As Long 

Public Function StrPtrToString(ByVal u As Long) As String 

    Dim s As String 
    s = StrConv(SysAllocString(u), vbFromUnicode) 

    StrPtrToString = s 

End Function 

Private Sub pUpdate(ByVal uPath As String) 

    Dim arrWTSSessions() As WTS_SESSION_INFO 
    arrWTSSessions = GetWTSSessions 

    WriteLog "We have " & UBound(arrWTSSessions) & " sessions." 

    Dim i& 
    For i = LBound(arrWTSSessions) To UBound(arrWTSSessions) 

'   // Extract each session info and check if it is the 
'   // "Active Session" of the current logged-on user. 
      Dim tSessionInfo As WTS_SESSION_INFO 
      tSessionInfo = arrWTSSessions(i) 

      WriteLog "Session " & i & " state: " & tSessionInfo.state & ", id: " & tSessionInfo.SessionID & ", name: " & StrPtrToString(tSessionInfo.pWinStationName) 

    Next i 

End Sub 

Private Function GetWTSSessions() As WTS_SESSION_INFO() 

    Dim RetVal As Long 
    Dim lpBuffer As Long 
    Dim lCount As Long 
    Dim p As Long 
    Dim arrSessionInfo() As WTS_SESSION_INFO 

    RetVal = WTSEnumerateSessions(WTS_CURRENT_SERVER_HANDLE, _ 
    0&, _ 
    1, _ 
    lpBuffer, _ 
    lCount) 

    If RetVal Then 
     ' WTSEnumerateProcesses was successful. 

     p = lpBuffer 
     ReDim arrSessionInfo(lCount - 1) '0) '0 to (lCount – 1)) 

     CopyMemory arrSessionInfo(0), ByVal p, lCount * LenB(arrSessionInfo(0)) 
     ' Free the memory buffer. 
     WTSFreeMemory lpBuffer 

    Else 
     ' Error occurred calling WTSEnumerateProcesses. 
     ' Check Err.LastDllError for error code. 
     MsgBox "An error occurred calling WTSEnumerateProcesses. " & _ 
     "Check the Platform SDK error codes in the MSDN Documentation " & _ 
     "for more information.", vbCritical, "ERROR " & Err.LastDllError 
    End If 

    GetWTSSessions = arrSessionInfo 

End Function 

Public Function StartAppInSessionAsAdmin(ByVal SessionID As String, ByVal WinstationNameStrPtr As Long, ByVal AppName As String) As Integer 

    If Not FileExists(AppName) Then 
     WriteLog "#FFOOOOOOOO! appname does not exist: " & AppName 
    End If 

    WriteLog "sta: " & StrPtrToString(WinstationNameStrPtr) 

    WriteLog "appname: " & AppName 

    WriteLog "pstartappinsessions step 1" 

    Dim hToken& 
    Dim hLinkedToken& 
    ' Dim bRet As Boolean 
    Dim pi As PROCESS_INFORMATION 
    Dim si As STARTUPINFO 
    Dim lErr& 
    Dim iRet& 
    Dim lpEB& 

    Dim TLT As TOKEN_LINKED_TOKEN 
    Dim TLTSize& 
    Dim retSize& 

    WriteLog "pstartappinsessions step 2" 

    si.lpDesktop = WinstationNameStrPtr 'StrPtr("Winsta0\default") ' WinstationName '”Winsta0\default” 
    si.cb = Len(si) 'Marshal.SizeOf(si) 

    WriteLog "pstartappinsessions step 3" 



    WriteLog "pstartappinsessions step 4" 

    TLTSize = Len(TLT.LinkedToken) '.SizeOf(TLT.LinkedToken) 

    WriteLog "pstartappinsessions step 5" 

    'get SessionID token 
    Dim bRet As Boolean 
    bRet = WTSQueryUserToken(SessionID, hToken) 

    WriteLog "wtsqueryusertoken: " & bRet 

    'we need to get the TokenLinked Token 
    bRet = GetTokenInformation(hToken, TOKEN_INFORMATION_CLASS.TokenLinkedToken, hLinkedToken, TLTSize, retSize) 

    WriteLog "gettokeninformation: " & bRet 

    'Use CreateEnvironment Block with the original token to create an environment for the new program with the USER Environment 
    bRet = CreateEnvironmentBlock(lpEB, hToken, False) 

    WriteLog "Createenvblock: " & bRet 

    If bRet Then 
     'NB. Must append a space before the command-line else it 
     ' will be chopped off up to the end of the first space in the string 
     'Call CreateProcessAsUser to create the process using the user's modified Token 

     iRet = CreateProcessAsUser(hLinkedToken, "", " " & AppName, 0&, 0&, 0&, NORMAL_PRIORITY_CLASS, 0&, 0&, si, pi) 


     'Give user a feedback 
     If iRet <> 0 Then 
      WriteLog ":-) createprocessasuser succeeded!" 
      'GiveFeedback(SessionID, "Message from StartAppInSessionAsAdmin", "CreateProcessAsUser succeeded", 2) 
     Else 
      WriteLog ":-(failed createprocessasuser! error: " & Err.LastDllError 
      'err = Marshal.GetLastWin32Error 
      'GiveFeedback(SessionID, "Message from StartAppInSessionAsAdmin", "CreateProcessAsUser failed with error " & err.ToString, 5) 
     End If 
    End If 

    WriteLog "pstartappinsessions}" 

End Function 

Private Sub WriteLog(ByVal uText As String) 

    WriteText Now & vbTab & uText, "c:\users\myuser\desktop\log.txt", False 

End Sub 
Public Function WriteText(ByVal uString As String, ByVal uPath As String, Optional ByVal uDeleteFileBeforeWriting As Boolean = False, Optional ByRef uError As String) As Boolean 
On Error GoTo Errhandler 

    If uDeleteFileBeforeWriting Then 
     If Not DeleteFile(uPath, uError) Then 
      Exit Function 
     End If 
    End If 

    If VBA.Len(uString) = 0 Then 
     uError = uError & " + no string" 
     Exit Function 
    End If 

    Debug.Assert VBA.Len(uPath) > 0 

    Dim fso As Object 'Scripting.FileSystemObject 
    Set fso = CreateObject("Scripting.FileSystemObject") 

    Dim strm As Object ' Scripting.TextStream 
    Set strm = fso.OpenTextFile(uPath, 8, True, -1) 

    strm.WriteLine uString 
    strm.Close 

    Set strm = Nothing 
    Set fso = Nothing 

    uError = "no error" 

    WriteText = True 

Exit Function 
Errhandler: 
uError = Err.Description & ": " & Err.Number 
On Error GoTo -1 
End Function 

Answer 1

bereits. Ich wechselte zu s = SysAllocStringByteLen(u, lstrlen(u))

Private Declare Function SysAllocStringByteLen Lib "oleaut32.dll" (ByVal m_pBase As Long, ByVal l As Long) As String 
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Long) As Long 

. .

Public Function StrPtrToString(ByVal u As Long) As String 

    Dim s As String 

    s = SysAllocStringByteLen(u, lstrlen(u)) 

    StrPtrToString = s 

End Function 

Answer 2

Edit: Eigentlich war es LPTSTR, so ist dies der richtige Code:

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (_ 
ByVal lpString1 As String, ByVal lpString2 As Long) As Long 

Public Function PointerToStringA(ByVal lpStringA As Long) As String 
    Dim nLen As Long 
    Dim sTemp As String 

    If lpStringA Then 
     nLen = lstrlenA(ByVal lpStringA) 
     If nLen Then 
     sTemp = String(nLen, vbNullChar) 
     lstrcpy sTemp, ByVal lpStringA 
     PointerToStringA = sTemp 
     End If 
    End If 
End Function