Natives Dateilisting

AHT · 4. Juni 2013, 13:22

Quellcode

'#####################################################################################
'######### Native XProfan Code von AHT #########
'######### erstellt für [URL]http://www.paules-pc-forum.de[/URL] #########
'#####################################################################################
Declare Ordner$, NtFehler%, Object_Attrib#, LSA_UNICODE#, Fehler%, IOStatus%, StatusBlock#
Declare UNICODE#, FileHandle%, FileInformation#, FileInformationLength&
Declare Offset%, FileNameLength&, Filename#, Ordner2$, Attributes&, PRIORITY&
Declare Offset1%
Ordner$ = ChooseDir$("Bitte Ordner auswählen:")
If Ordner$ <> ""
If Len(Ordner$) > 3
If Right$(Ordner$, 1) = "\"
Ordner$ = Left$(Ordner$, len(Ordner$)-1)
endif
endif
Ordner2$ = Ordner$
Ordner$ = "[URL='file://\\??\\']\\??\\[/URL]" + Ordner$
DIM Object_Attrib#, 24
DIM LSA_UNICODE#, 8
Dim UNICODE#, len(Ordner$) * 2 + 4
DIM StatusBlock#, 16
Dim Filename#, 600
Fehler% = External("kernel32", "MultiByteToWideChar", 0, 0, addr(Ordner$), -1, UNICODE#, int(len(Ordner$) + 2))
Long Object_Attrib#, 0 = 24
Long Object_Attrib#, 4 = 0
Long Object_Attrib#, 12 = $40 | $80
WORD LSA_UNICODE#, 0 = len(Ordner$) * 2
WORD LSA_UNICODE#, 2 = len(Ordner$) * 2 + 2
LONG LSA_UNICODE#, 4 = UNICODE#
Long Object_Attrib#, 8 = LSA_UNICODE#
NtFehler% = External("ntdll", "NtOpenFile", addr(FileHandle%), $1, Object_Attrib#, StatusBlock#, $4 | $2 | $1, $1)
IF NtFehler% = 0
FileInformationLength& = 30000000
Dim FileInformation#, FileInformationLength&
Clear StatusBlock#
PRIORITY& = External("kernel32", "GetPriorityClass", External("kernel32", "GetCurrentProcess"))
Fehler% = External("kernel32", "SetPriorityClass", external("kernel32", "GetCurrentProcess"), $40)
NtFehler% = External("ntdll", "NtQueryDirectoryFile", FileHandle%, 0, 0, 0, StatusBlock#, FileInformation#, FileInformationLength&, 2, 0, 0, 1)
Sleep 1
Fehler% = External("kernel32", "SetPriorityClass", external("kernel32", "GetCurrentProcess"), PRIORITY&)
Offset% = 0
If (NtFehler% = 0) or (NtFehler% = 259)
Repeat
FileNameLength& = Long(FileInformation#, Offset% + 60)
Attributes& = Long(FileInformation#, Offset% + 56)
Clear Filename#
Fehler% = External("kernel32", "WideCharToMultiByte", 0, 0, FileInformation# + Offset% + 68, int(FileNameLength& / 2), Filename#, 500 , 0, 0)
If Attributes& | $10 = Attributes&
AddString "[' + String$(Filename#, 0) + ']"
else
AddString String$(Filename#, 0)
endif
Offset1% = Long(FileInformation#, Offset%)
Offset% = Offset% + Long(FileInformation#, Offset%)
until Offset1% = 0
endif
NtFehler% = External("ntdll", "NtClose", FileHandle%)
Dispose FileInformation#
endif
EditBox("inhalt von " + Ordner2$, 0)
Dispose Filename#
Dispose StatusBlock#
Dispose UNICODE#
Dispose LSA_UNICODE#
Dispose Object_Attrib#
endif

Alles anzeigen

AHT · 4. Juni 2013, 22:41

Möglichkeit 2

Quellcode

'#####################################################################################
'######### Native XProfan Code von AHT #########
'######### erstellt für [URL]http://www.paules-pc-forum.de[/URL] #########
'#####################################################################################
Declare Ordner$, NtFehler%, Object_Attrib#, LSA_UNICODE#, Fehler%, IOStatus%, StatusBlock#
Declare UNICODE#, FileHandle%, FileInformation#, FileInformationLength&
Declare Offset%, FileNameLength&, Filename#, Ordner2$, Attributes&, PRIORITY&
Ordner$ = ChooseDir$("Bitte Ordner auswählen:")
If Ordner$ <> ""
If Len(Ordner$) > 3
If Right$(Ordner$, 1) = "\"
Ordner$ = Left$(Ordner$, len(Ordner$)-1)
endif
endif
Ordner2$ = Ordner$
Ordner$ = "[URL='file://\\??\\']\\??\\[/URL]" + Ordner$
DIM Object_Attrib#, 24
DIM LSA_UNICODE#, 8
Dim UNICODE#, len(Ordner$) * 2 + 4
DIM StatusBlock#, 16
Dim Filename#, 600
Fehler% = External("kernel32", "MultiByteToWideChar", 0, 0, addr(Ordner$), -1, UNICODE#, int(len(Ordner$) + 2))
Long Object_Attrib#, 0 = 24
Long Object_Attrib#, 4 = 0
Long Object_Attrib#, 12 = $40 | $80
WORD LSA_UNICODE#, 0 = len(Ordner$) * 2
WORD LSA_UNICODE#, 2 = len(Ordner$) * 2 + 2
LONG LSA_UNICODE#, 4 = UNICODE#
Long Object_Attrib#, 8 = LSA_UNICODE#
NtFehler% = External("ntdll", "NtOpenFile", addr(FileHandle%), $1, Object_Attrib#, StatusBlock#, $4 | $2 | $1, $1)
IF NtFehler% = 0
FileInformationLength& = 8000
Dim FileInformation#, FileInformationLength&
Clear StatusBlock#
PRIORITY& = External("kernel32", "GetPriorityClass", External("kernel32", "GetCurrentProcess"))
Fehler% = External("kernel32", "SetPriorityClass", external("kernel32", "GetCurrentProcess"), $40)
NtFehler% = External("ntdll", "NtQueryDirectoryFile", FileHandle%, 0, 0, 0, StatusBlock#, FileInformation#, FileInformationLength&, 2, 1, 0, 1)
If Long(StatusBlock#, 4) <> 0
Attributes& = Long(FileInformation#, Offset% + 56)
FileNameLength& = Long(FileInformation#, Offset% + 60)
Clear Filename#
Fehler% = External("kernel32", "WideCharToMultiByte", 0, 0, FileInformation# + Offset% + 68, int(FileNameLength& / 2), Filename#, 500 , 0, 0)
If Attributes& | $10 = Attributes&
AddString "[' + String$(Filename#, 0) + ']"
else
AddString String$(Filename#, 0)
endif
While Long(StatusBlock#, 4) <> 0
NtFehler% = External("ntdll", "NtQueryDirectoryFile", FileHandle%, 0, 0, 0, StatusBlock#, FileInformation#, FileInformationLength&, 2, 1, 0, 0)
If Long(StatusBlock#, 4) <> 0
FileNameLength& = Long(FileInformation#, Offset% + 60)
Attributes& = Long(FileInformation#, Offset% + 56)
Clear Filename#
Fehler% = External("kernel32", "WideCharToMultiByte", 0, 0, FileInformation# + Offset% + 68, int(FileNameLength& / 2), Filename#, 500 , 0, 0)
If Attributes& | $10 = Attributes&
AddString "[' + String$(Filename#, 0) + ']"
else
AddString String$(Filename#, 0)
endif
endif
EndWhile
endif
Fehler% = External("kernel32", "SetPriorityClass", external("kernel32", "GetCurrentProcess"), PRIORITY&)
NtFehler% = External("ntdll", "NtClose", FileHandle%)
Dispose FileInformation#
endif
EditBox("inhalt von " + Ordner2$, 0)
Dispose Filename#
Dispose StatusBlock#
Dispose UNICODE#
Dispose LSA_UNICODE#
Dispose Object_Attrib#
endif

Alles anzeigen

AHT · 5. Juni 2013, 14:47

Möglichkeit 2 wäre wohl vorzuziehen, da man bei 1 nicht ohne weiteres an die nötige Buffergröße kommt und der Buffer sehr groß werden kann...

PS: Ist erst mal unter 32Bit Vista getestet. Muss das Zeug noch auf anderen Systen laufen lassen.

AHT · 5. Juni 2013, 15:04

Geht so leider nicht - da muss ich bei beidem noch mal ran. Unter 64bit sehe ich jetzt aber, wo das hakt.

AHT · 5. Juni 2013, 15:47

Fehler gefunden.
Die Funktion gibt scheinbar die Aufgabe zum Füllen des Buffers an den Kernel weiter, kehrt aber zurück, bevor der Buffer gefüllt wurde. Auch wenn das in der Dokumentation nicht erwähnt wird, kommt man da wohl nicht ganz ohne Event aus. Neuer Versuch:

Möglichkeit 1:

Quellcode

'#####################################################################################
'######### Native XProfan Code von AHT #########
'######### erstellt für [URL]http://www.paules-pc-forum.de[/URL] #########
'#####################################################################################
Declare Ordner$, NtFehler%, Object_Attrib#, LSA_UNICODE#, Fehler%, IOStatus%, StatusBlock#
Declare UNICODE#, FileHandle%, FileInformation#, FileInformationLength&
Declare Offset%, FileNameLength&, Filename#, Ordner2$, Attributes&, PRIORITY&
Declare Offset1%, Event$, Event&, Wait&
Ordner$ = ChooseDir$("Bitte Ordner auswählen:")
If Ordner$ <> ""
If Len(Ordner$) > 3
If Right$(Ordner$, 1) = "\"
Ordner$ = Left$(Ordner$, len(Ordner$)-1)
endif
endif
Ordner2$ = Ordner$
Ordner$ = "[URL='file://\\??\\']\\??\\[/URL]" + Ordner$
DIM Object_Attrib#, 24
DIM LSA_UNICODE#, 8
Dim UNICODE#, len(Ordner$) * 2 + 4
DIM StatusBlock#, 16
Dim Filename#, 600
Fehler% = External("kernel32", "MultiByteToWideChar", 0, 0, addr(Ordner$), -1, UNICODE#, int(len(Ordner$) + 2))
Long Object_Attrib#, 0 = 24
Long Object_Attrib#, 4 = 0
Long Object_Attrib#, 12 = $40 | $80
WORD LSA_UNICODE#, 0 = len(Ordner$) * 2
WORD LSA_UNICODE#, 2 = len(Ordner$) * 2 + 2
LONG LSA_UNICODE#, 4 = UNICODE#
Long Object_Attrib#, 8 = LSA_UNICODE#
Event$ = "Event a"+STR$(&Gettickcount)
Event& = External("kernel32", "CreateEventA", 0,1,1,addr(Event$))
NtFehler% = External("ntdll", "NtOpenFile", addr(FileHandle%), $1, Object_Attrib#, StatusBlock#, $4 | $2 | $1, $1)
IF NtFehler% = 0
FileInformationLength& = 30000000
Dim FileInformation#, FileInformationLength&
Clear StatusBlock#
NtFehler% = External("ntdll", "NtQueryDirectoryFile", FileHandle%, Event&, 0, 0, StatusBlock#, FileInformation#, FileInformationLength&, 2, 0, 0, 1)
Offset% = 0
If (NtFehler% = 0) or (NtFehler% = 259)
Wait& = External("kernel32", "WaitForSingleObject", Event&, 10000)
Repeat
FileNameLength& = Long(FileInformation#, Offset% + 60)
Attributes& = Long(FileInformation#, Offset% + 56)
Clear Filename#
Fehler% = External("kernel32", "WideCharToMultiByte", 0, 0, FileInformation# + Offset% + 68, int(FileNameLength& / 2), Filename#, 500 , 0, 0)
If Attributes& | $10 = Attributes&
AddString "[' + String$(Filename#, 0) + ']"
else
AddString String$(Filename#, 0)
endif
Offset1% = Long(FileInformation#, Offset%)
Offset% = Offset% + Long(FileInformation#, Offset%)
until Offset1% = 0
endif
External("kernel32", "CloseHandle", Event&)
NtFehler% = External("ntdll", "NtClose", FileHandle%)
Dispose FileInformation#
endif
EditBox("inhalt von " + Ordner2$, 0)
Dispose Filename#
Dispose StatusBlock#
Dispose UNICODE#
Dispose LSA_UNICODE#
Dispose Object_Attrib#
endif

Alles anzeigen

Möglichkeit 2:

Quellcode

'#####################################################################################
'######### Native XProfan Code von AHT #########
'######### erstellt für [URL]http://www.paules-pc-forum.de[/URL] #########
'#####################################################################################
Declare Ordner$, NtFehler%, Object_Attrib#, LSA_UNICODE#, Fehler%, IOStatus%, StatusBlock#
Declare UNICODE#, FileHandle%, FileInformation#, FileInformationLength&
Declare Offset%, FileNameLength&, Filename#, Ordner2$, Attributes&, PRIORITY&
Declare Event$, Event&, Wait&
Ordner$ = ChooseDir$("Bitte Ordner auswählen:")
If Ordner$ <> ""
If Len(Ordner$) > 3
If Right$(Ordner$, 1) = "\"
Ordner$ = Left$(Ordner$, len(Ordner$)-1)
endif
endif
Ordner2$ = Ordner$
Ordner$ = "[URL='file://\\??\\']\\??\\[/URL]" + Ordner$
DIM Object_Attrib#, 24
DIM LSA_UNICODE#, 8
Dim UNICODE#, len(Ordner$) * 2 + 4
DIM StatusBlock#, 16
Dim Filename#, 600
Fehler% = External("kernel32", "MultiByteToWideChar", 0, 0, addr(Ordner$), -1, UNICODE#, int(len(Ordner$) + 2))
Long Object_Attrib#, 0 = 24
Long Object_Attrib#, 4 = 0
Long Object_Attrib#, 12 = $40 | $80
WORD LSA_UNICODE#, 0 = len(Ordner$) * 2
WORD LSA_UNICODE#, 2 = len(Ordner$) * 2 + 2
LONG LSA_UNICODE#, 4 = UNICODE#
Long Object_Attrib#, 8 = LSA_UNICODE#
Event$ = "Event b"+STR$(&Gettickcount)
Event& = External("kernel32", "CreateEventA", 0,1,1,addr(Event$))
NtFehler% = External("ntdll", "NtOpenFile", addr(FileHandle%), $1, Object_Attrib#, StatusBlock#, $4 | $2 | $1, $1)
IF NtFehler% = 0
FileInformationLength& = 8000
Dim FileInformation#, FileInformationLength&
Clear StatusBlock#
NtFehler% = External("ntdll", "NtQueryDirectoryFile", FileHandle%, Event&, 0, 0, StatusBlock#, FileInformation#, FileInformationLength&, 2, 1, 0, 1)
IF (NtFehler% = 0) or (NtFehler% = 259)
Wait& = External("kernel32", "WaitForSingleObject", Event&, 10000)
External("kernel32", "ResetEvent", Event&)
If Long(StatusBlock#, 4) <> 0
Attributes& = Long(FileInformation#, Offset% + 56)
FileNameLength& = Long(FileInformation#, Offset% + 60)
Clear Filename#
Fehler% = External("kernel32", "WideCharToMultiByte", 0, 0, FileInformation# + Offset% + 68, int(FileNameLength& / 2), Filename#, 500 , 0, 0)
If Attributes& | $10 = Attributes&
AddString "[' + String$(Filename#, 0) + ']"
else
AddString String$(Filename#, 0)
endif
While Long(StatusBlock#, 4) <> 0
Clear StatusBlock#
NtFehler% = External("ntdll", "NtQueryDirectoryFile", FileHandle%, Event&, 0, 0, StatusBlock#, FileInformation#, FileInformationLength&, 2, 1, 0, 0)
IF (NtFehler% = 0) or (NtFehler% = 259)
Wait& = External("kernel32", "WaitForSingleObject", Event&, 10000)
External("kernel32", "ResetEvent", Event&)
If Long(StatusBlock#, 4) <> 0
FileNameLength& = Long(FileInformation#, Offset% + 60)
Attributes& = Long(FileInformation#, Offset% + 56)
Clear Filename#
Fehler% = External("kernel32", "WideCharToMultiByte", 0, 0, FileInformation# + Offset% + 68, int(FileNameLength& / 2), Filename#, 500 , 0, 0)
If Attributes& | $10 = Attributes&
AddString "[' + String$(Filename#, 0) + ']"
else
AddString String$(Filename#, 0)
endif
endif
endif
EndWhile
endif
endif
External("kernel32", "CloseHandle", Event&)
NtFehler% = External("ntdll", "NtClose", FileHandle%)
Dispose FileInformation#
endif
EditBox("inhalt von " + Ordner2$, 0)
Dispose Filename#
Dispose StatusBlock#
Dispose UNICODE#
Dispose LSA_UNICODE#
Dispose Object_Attrib#
endif

Alles anzeigen

p. specht · 5. Juni 2013, 16:27

Könnest Du zum Einsatzbereich bitte ein paar Angaben machen?
Ist das ein Workaround?
Gruss, P. Specht

AHT · 5. Juni 2013, 16:33

Im Prinzip wird da nichts anderes gemacht, als bei FindFirst$/ FindNext$.
Ich brauch das als Grundlage für was spezielleres.
Neuer Versuch:

Möglichkeit 1:

Quellcode

'#####################################################################################
'######### Native XProfan Code von AHT #########
'######### erstellt für [URL]http://www.paules-pc-forum.de[/URL] #########
'#####################################################################################
Declare Ordner$, NtFehler%, Object_Attrib#, LSA_UNICODE#, Fehler%, IOStatus%, StatusBlock#
Declare UNICODE#, FileHandle%, FileInformation#, FileInformationLength&
Declare Offset%, FileNameLength&, Filename#, Ordner2$, Attributes&, PRIORITY&
Declare Offset1%, Event%, Wait&
Ordner$ = ChooseDir$("Bitte Ordner auswählen:")
If Ordner$ <> ""
If Len(Ordner$) > 3
If Right$(Ordner$, 1) = "\"
Ordner$ = Left$(Ordner$, len(Ordner$)-1)
endif
endif
Ordner2$ = Ordner$
Ordner$ = "[URL='file://\\??\\']\\??\\[/URL]" + Ordner$
DIM Object_Attrib#, 24
DIM LSA_UNICODE#, 8
Dim UNICODE#, len(Ordner$) * 2 + 4
DIM StatusBlock#, 16
Dim Filename#, 600
Fehler% = External("kernel32", "MultiByteToWideChar", 0, 0, addr(Ordner$), -1, UNICODE#, int(len(Ordner$) + 2))
Long Object_Attrib#, 0 = 24
Long Object_Attrib#, 4 = 0
Long Object_Attrib#, 12 = $40 | $80
WORD LSA_UNICODE#, 0 = len(Ordner$) * 2
WORD LSA_UNICODE#, 2 = len(Ordner$) * 2 + 2
LONG LSA_UNICODE#, 4 = UNICODE#
Long Object_Attrib#, 8 = LSA_UNICODE#
Event% = External("kernel32", "CreateEventA", 0, 1, 0, 0)
NtFehler% = External("ntdll", "NtOpenFile", addr(FileHandle%), $1, Object_Attrib#, StatusBlock#, $4 | $2 | $1, $1)
IF NtFehler% = 0
FileInformationLength& = 500000
Dim FileInformation#, FileInformationLength&
Clear StatusBlock#
External("kernel32", "ResetEvent", Event%)
NtFehler% = External("ntdll", "NtQueryDirectoryFile", FileHandle%, Event%, 0, 0, StatusBlock#, FileInformation#, FileInformationLength&, 2, 0, 0, 1)
Offset% = 0
If (NtFehler% = 0) or (NtFehler% = 259)
Wait& = External("kernel32", "WaitForSingleObject", Event%, 10000)
Repeat
FileNameLength& = Long(FileInformation#, Offset% + 60)
Attributes& = Long(FileInformation#, Offset% + 56)
Clear Filename#
Fehler% = External("kernel32", "WideCharToMultiByte", 0, 0, FileInformation# + Offset% + 68, int(FileNameLength& / 2), Filename#, 500 , 0, 0)
If Attributes& | $10 = Attributes&
AddString "[' + String$(Filename#, 0) + ']"
else
AddString String$(Filename#, 0)
endif
Offset1% = Long(FileInformation#, Offset%)
Offset% = Offset% + Long(FileInformation#, Offset%)
until Offset1% = 0
endif
External("kernel32", "CloseHandle", Event%)
NtFehler% = External("ntdll", "NtClose", FileHandle%)
Dispose FileInformation#
endif
EditBox("inhalt von " + Ordner2$, 0)
Dispose Filename#
Dispose StatusBlock#
Dispose UNICODE#
Dispose LSA_UNICODE#
Dispose Object_Attrib#
endif

Alles anzeigen

Möglichkeit 2:

Quellcode

'#####################################################################################
'######### Native XProfan Code von AHT #########
'######### erstellt für [URL]http://www.paules-pc-forum.de[/URL] #########
'#####################################################################################
Declare Ordner$, NtFehler%, Object_Attrib#, LSA_UNICODE#, Fehler%, IOStatus%, StatusBlock#
Declare UNICODE#, FileHandle%, FileInformation#, FileInformationLength&
Declare Offset%, FileNameLength&, Filename#, Ordner2$, Attributes&, PRIORITY&
Declare Event&, Wait&
Ordner$ = ChooseDir$("Bitte Ordner auswählen:")
If Ordner$ <> ""
If Len(Ordner$) > 3
If Right$(Ordner$, 1) = "\"
Ordner$ = Left$(Ordner$, len(Ordner$)-1)
endif
endif
Ordner2$ = Ordner$
Ordner$ = "[URL='file://\\??\\']\\??\\[/URL]" + Ordner$
DIM Object_Attrib#, 24
DIM LSA_UNICODE#, 8
Dim UNICODE#, len(Ordner$) * 2 + 4
DIM StatusBlock#, 16
Dim Filename#, 600
Fehler% = External("kernel32", "MultiByteToWideChar", 0, 0, addr(Ordner$), -1, UNICODE#, int(len(Ordner$) + 2))
Long Object_Attrib#, 0 = 24
Long Object_Attrib#, 4 = 0
Long Object_Attrib#, 12 = $40 | $80
WORD LSA_UNICODE#, 0 = len(Ordner$) * 2
WORD LSA_UNICODE#, 2 = len(Ordner$) * 2 + 2
LONG LSA_UNICODE#, 4 = UNICODE#
Long Object_Attrib#, 8 = LSA_UNICODE#
Event& = External("kernel32", "CreateEventA", 0, 1, 0, 0)
NtFehler% = External("ntdll", "NtOpenFile", addr(FileHandle%), $1, Object_Attrib#, StatusBlock#, $4 | $2 | $1, $1)
IF NtFehler% = 0
FileInformationLength& = 8000
Dim FileInformation#, FileInformationLength&
Clear StatusBlock#
NtFehler% = External("ntdll", "NtQueryDirectoryFile", FileHandle%, Event&, 0, 0, StatusBlock#, FileInformation#, FileInformationLength&, 2, 1, 0, 1)
IF (NtFehler% = 0) or (NtFehler% = 259)
Wait& = External("kernel32", "WaitForSingleObject", Event&, 10000)
External("kernel32", "ResetEvent", Event&)
If Long(StatusBlock#, 4) <> 0
Attributes& = Long(FileInformation#, Offset% + 56)
FileNameLength& = Long(FileInformation#, Offset% + 60)
Clear Filename#
Fehler% = External("kernel32", "WideCharToMultiByte", 0, 0, FileInformation# + Offset% + 68, int(FileNameLength& / 2), Filename#, 500 , 0, 0)
If Attributes& | $10 = Attributes&
AddString "[' + String$(Filename#, 0) + ']"
else
AddString String$(Filename#, 0)
endif
While Long(StatusBlock#, 4) <> 0
Clear StatusBlock#
NtFehler% = External("ntdll", "NtQueryDirectoryFile", FileHandle%, Event&, 0, 0, StatusBlock#, FileInformation#, FileInformationLength&, 2, 1, 0, 0)
IF (NtFehler% = 0) or (NtFehler% = 259)
Wait& = External("kernel32", "WaitForSingleObject", Event&, 10000)
External("kernel32", "ResetEvent", Event&)
If Long(StatusBlock#, 4) <> 0
FileNameLength& = Long(FileInformation#, Offset% + 60)
Attributes& = Long(FileInformation#, Offset% + 56)
Clear Filename#
Fehler% = External("kernel32", "WideCharToMultiByte", 0, 0, FileInformation# + Offset% + 68, int(FileNameLength& / 2), Filename#, 500 , 0, 0)
If Attributes& | $10 = Attributes&
AddString "[' + String$(Filename#, 0) + ']"
else
AddString String$(Filename#, 0)
endif
endif
endif
EndWhile
endif
endif
External("kernel32", "CloseHandle", Event&)
NtFehler% = External("ntdll", "NtClose", FileHandle%)
Dispose FileInformation#
endif
EditBox("inhalt von " + Ordner2$, 0)
Dispose Filename#
Dispose StatusBlock#
Dispose UNICODE#
Dispose LSA_UNICODE#
Dispose Object_Attrib#
endif

Alles anzeigen

AHT · 5. Juni 2013, 17:25

Läuft immer noch nicht sicher. Muss mal schauen, was da Sache ist...

AHT · 5. Juni 2013, 17:52

Scheint an der 9.1 Version von XProfan zu liegen.
Mit X2 läuft die Sache:

Möglichkeit 1:

Quellcode

'#####################################################################################
'######### Native XProfan Code von AHT #########
'######### erstellt für [URL]http://www.paules-pc-forum.de[/URL] #########
'#####################################################################################
Declare Ordner$, NtFehler%, Object_Attrib#, LSA_UNICODE#, Fehler%, IOStatus%, StatusBlock#
Declare UNICODE#, FileHandle%, FileInformation#, FileInformationLength&
Declare Offset%, FileNameLength&, Filename#, Ordner2$, Attributes&, PRIORITY&
Declare Offset1%, Event%, Wait&
Ordner$ = ChooseDir$("Bitte Ordner auswählen:")
If Ordner$ <> ""
If Len(Ordner$) > 3
If Right$(Ordner$, 1) = "\"
Ordner$ = Left$(Ordner$, len(Ordner$)-1)
endif
endif
Ordner2$ = Ordner$
Ordner$ = "[URL='file://\\??\\']\\??\\[/URL]" + Ordner$
DIM Object_Attrib#, 24
DIM LSA_UNICODE#, 8
Dim UNICODE#, len(Ordner$) * 2 + 4
DIM StatusBlock#, 16
Dim Filename#, 600
Fehler% = External("kernel32", "MultiByteToWideChar", 0, 0, addr(Ordner$), -1, UNICODE#, int(len(Ordner$) + 2))
Long Object_Attrib#, 0 = 24
Long Object_Attrib#, 4 = 0
Long Object_Attrib#, 12 = $40 | $80
WORD LSA_UNICODE#, 0 = len(Ordner$) * 2
WORD LSA_UNICODE#, 2 = len(Ordner$) * 2 + 2
LONG LSA_UNICODE#, 4 = UNICODE#
Long Object_Attrib#, 8 = LSA_UNICODE#
Event% = External("kernel32", "CreateEventA", 0, 0, 0, 0)
NtFehler% = External("ntdll", "NtOpenFile", addr(FileHandle%), $1, Object_Attrib#, StatusBlock#, $4 | $2 | $1, $1)
IF NtFehler% = 0
FileInformationLength& = 30000000
Dim FileInformation#, FileInformationLength&
Clear StatusBlock#
NtFehler% = External("ntdll", "NtQueryDirectoryFile", FileHandle%, Event%, 0, 0, StatusBlock#, FileInformation#, FileInformationLength&, 2, 0, 0, 1)
Offset% = 0
If (NtFehler% = 0) or (NtFehler% = 259)
Wait& = External("kernel32", "WaitForSingleObject", Event%, 10000)
Repeat
FileNameLength& = Long(FileInformation#, Offset% + 60)
Attributes& = Long(FileInformation#, Offset% + 56)
Clear Filename#
Fehler% = External("kernel32", "WideCharToMultiByte", 0, 0, FileInformation# + Offset% + 68, int(FileNameLength& / 2), Filename#, 500 , 0, 0)
If Attributes& | $10 = Attributes&
AddString "[' + String$(Filename#, 0) + ']"
else
AddString String$(Filename#, 0)
endif
Offset1% = Long(FileInformation#, Offset%)
Offset% = Offset% + Long(FileInformation#, Offset%)
until Offset1% = 0
endif
External("kernel32", "CloseHandle", Event%)
NtFehler% = External("ntdll", "NtClose", FileHandle%)
Dispose FileInformation#
endif
EditBox("inhalt von " + Ordner2$, 0)
Dispose Filename#
Dispose StatusBlock#
Dispose UNICODE#
Dispose LSA_UNICODE#
Dispose Object_Attrib#
endif

Alles anzeigen

Möglichkeit 2:

Quellcode

'#####################################################################################
'######### Native XProfan Code von AHT #########
'######### erstellt für [URL]http://www.paules-pc-forum.de[/URL] #########
'#####################################################################################
Declare Ordner$, NtFehler%, Object_Attrib#, LSA_UNICODE#, Fehler%, IOStatus%, StatusBlock#
Declare UNICODE#, FileHandle%, FileInformation#, FileInformationLength&
Declare Offset%, FileNameLength&, Filename#, Ordner2$, Attributes&
Declare Event&, Wait&
Ordner$ = ChooseDir$("Bitte Ordner auswählen:")
If Ordner$ <> ""
If Len(Ordner$) > 3
If Right$(Ordner$, 1) = "\"
Ordner$ = Left$(Ordner$, len(Ordner$)-1)
endif
endif
Ordner2$ = Ordner$
Ordner$ = "[URL='file://\\??\\']\\??\\[/URL]" + Ordner$
DIM Object_Attrib#, 24
DIM LSA_UNICODE#, 8
Dim UNICODE#, len(Ordner$) * 2 + 4
DIM StatusBlock#, 24
Dim Filename#, 600
Fehler% = External("kernel32", "MultiByteToWideChar", 0, 0, addr(Ordner$), -1, UNICODE#, int(len(Ordner$) + 2))
Long Object_Attrib#, 0 = 24
Long Object_Attrib#, 4 = 0
Long Object_Attrib#, 12 = $40 | $80
WORD LSA_UNICODE#, 0 = len(Ordner$) * 2
WORD LSA_UNICODE#, 2 = len(Ordner$) * 2 + 2
LONG LSA_UNICODE#, 4 = UNICODE#
Long Object_Attrib#, 8 = LSA_UNICODE#
Event& = External("kernel32", "CreateEventA", 0, 0, 0, 0)
Wait& = External("kernel32", "WaitForSingleObject", Event&, 10000)
NtFehler% = External("ntdll", "NtOpenFile", addr(FileHandle%), $1, Object_Attrib#, StatusBlock#, $4 | $2 | $1, $1)
IF NtFehler% = 0
FileInformationLength& = 10000
Dim FileInformation#, FileInformationLength&
Clear StatusBlock#
NtFehler% = External("ntdll", "NtQueryDirectoryFile", FileHandle%, Event&, 0, 0, StatusBlock#, FileInformation#, FileInformationLength&, 2, 1, 0, 1)
IF (NtFehler% = 0) or (NtFehler% = 259)
Wait& = External("kernel32", "WaitForSingleObject", Event&, 10000)
If Long(StatusBlock#, 0) <> -2147483642
Attributes& = Long(FileInformation#, Offset% + 56)
FileNameLength& = Long(FileInformation#, Offset% + 60)
Clear Filename#
Fehler% = External("kernel32", "WideCharToMultiByte", 0, 0, FileInformation# + Offset% + 68, int(FileNameLength& / 2), Filename#, 500 , 0, 0)
If Attributes& | $10 = Attributes&
AddString "[' + String$(Filename#, 0) + ']"
else
AddString String$(Filename#, 0)
endif
While Long(StatusBlock#, 0) <> -2147483642
Clear StatusBlock#
NtFehler% = External("ntdll", "NtQueryDirectoryFile", FileHandle%, Event&, 0, 0, StatusBlock#, FileInformation#, FileInformationLength&, 2, 1, 0, 0)
IF (NtFehler% = 0) or (NtFehler% = 259)
Wait& = External("kernel32", "WaitForSingleObject", Event&, 10000)
If Long(StatusBlock#, 4) <> 0
FileNameLength& = Long(FileInformation#, Offset% + 60)
Attributes& = Long(FileInformation#, Offset% + 56)
Clear Filename#
Fehler% = External("kernel32", "WideCharToMultiByte", 0, 0, FileInformation# + Offset% + 68, int(FileNameLength& / 2), Filename#, 500 , 0, 0)
If Attributes& | $10 = Attributes&
AddString "[' + String$(Filename#, 0) + ']"
else
AddString String$(Filename#, 0)
endif
endif
endif
EndWhile
endif
endif
External("kernel32", "CloseHandle", Event&)
NtFehler% = External("ntdll", "NtClose", FileHandle%)
Dispose FileInformation#
endif
EditBox("inhalt von " + Ordner2$, 0)
Dispose Filename#
Dispose StatusBlock#
Dispose UNICODE#
Dispose LSA_UNICODE#
Dispose Object_Attrib#
endif

Alles anzeigen

AHT · 5. Juni 2013, 17:57

Unter 9.1 wird der Buffer zeitweise nicht richtig gefüllt.
Wo funktionieren die letzten Codes, wo nicht? Welche XProfan Version?
Welches Windoes System?

AHT · 5. Juni 2013, 19:12

..tritt bei mir bislang nur unter Windows7 64Bit auf - da in XProfan 9.1 in der EXE und im Interpreter. In der EXE passiert das aber häufiger.
Mit X2 passiert nirgendwo mit dem gleichen Code ein Fehler - ich schau da noch mal auf meinen anderen Maschinen...
Unter

Vista 32Bit
Windows8 64Bit
Windows XP Pro 32Bit

passiert auch mit XProfan 9.1 bei mir kein Fehler und der Buffer wird korrekt gefüllt. Merkwürdige Sache...

Jonathan · 5. Juni 2013, 20:09

XProfan X2.1 auf Windows 7 Home Premium 64 lief im Interpreter immer 100% korrekt, mit der Runtime lieferte es einmal (10 Tests) eine leere Listbox.

Gruß
Jonathan

AHT · 6. Juni 2013, 07:40

Ok, dann tritt es da nur weniger auf. Kann einer einen Fehler im Code entdecken?
Bei welchem Code trat das auf?

PS: Bei mir war nicht nur die Listbox leer, manchmal fehlten einfach Einträge (die Stelle war leer) oder es waren welche doppelt.

p. specht · 6. Juni 2013, 10:05

((( Verdacht meiner Reinigungsfachkraft: Sperrt vielleicht irgend ein Antivirusprogramm gerade das Verzeichnis, weil ein verdächtiger Lesevorgang erst von der Heuristik geklärt werden muss, - und da gibt's halt manchmal einen timeout? )))

AHT · 6. Juni 2013, 13:52

Nein, das auf keinen Fall. Es ist entweder ein Fehler im Code oder es passt was mit XProfan nicht. Da es mit X2 fast immer funktioniert (bei mir geht es bislang immer mit X2), befürchte ich im Augenblick, das etwas mit XProfan nicht stimmt.

RGH · 6. Juni 2013, 14:48

AHT;976498 schrieb:

Nein, das auf keinen Fall. Es ist entweder ein Fehler im Code oder es passt was mit XProfan nicht. Da es mit X2 fast immer funktioniert (bei mir geht es bislang immer mit X2), befürchte ich im Augenblick, das etwas mit XProfan nicht stimmt.

Also bei mir hier im Büro (Windows 7/64, XProfan 2.1) gibt es keine Probleme. Wieso sollt mit XProfan was nicht stimmen, wenn es nach Deiner Aussage mit X2 immer geht?

Gruß
Roland

AHT · 6. Juni 2013, 15:05

Ich habe hier nicht 1000 Rechner zur Verfügung, um Sachen testen zu können - sind nur an die 20. Schau hier: paules-pc-forum.de/forum/spezi…eilisting.html#post976423

Das tritt zeitweise auf. Auch unter XProfan 9.1 tritt das Problem bei mir nicht auf jedem Rechner auf.

RGH · 6. Juni 2013, 16:51

AHT;976504 schrieb:

Ich habe hier nicht 1000 Rechner zur Verfügung, um Sachen testen zu können - sind nur an die 20.

Da hast Du schon etwa das fünffache von dem, was mir zur Verfügung steht.

Gruß
Roland

AHT · 11. Juni 2013, 17:38

Das klappt mit dem Event nicht. Die Funktion ist (zumindestens in XProfan) noch nicht fertig - bzw. die Buffer sind nicht gefüllt - wenn der Event signalisiert ist.
Ich habe da wohl eine Lösung gefunden. Muss die noch mal testen.

AHT · 11. Juni 2013, 18:49

...ich bekomme immer mehr den Eindruck, dass das an XProfan liegt. Kann es sein, dass da zu einem Zeitpunkt lesend oder schreibend auf den Buffer FileInformation# zugegriffen wird, am dem Windows den noch füllt und deshalb damit nicht zurechtkommt?
Die Funktion läuft ja scheinbar asynchron ab.