XProfan

- Seite 2 -

Ein XProfan11-String besteht aus 2 Longs und die Bytes. Erstes Long ist ein Zählerwert (von Delphi verwaltet) und Zweites die Stringlänge. Die Funktion addr gibt aber nicht die Stringadresse zurück, sondern zeigt auf die ersten Bytes im String, zeigt also auf die Adresse+8.
Kompilieren Markieren Separieren

var s$="Test"
var a&=addr(s$)
print long(a&,-8),long(a&,-4)
waitInput
var s2$=""
print addr(s2$)
waitInput

Für Api-Params nach lpz reicht die direkte Adresse auf Bytes+z.

Das Beispiel zeigt auch einen mit der dynamischen Stringspeicherverwaltung zusammenhängenden Problemfall.

Frank
Abbing

Darf man die GlobalAllocs eigentlich genauso verschieben wie Profan-Bereiche, also nach dem Schema Bereich# = Long&, oder benötigen jene dafür einen entsprechenden Stil?

Bei den Flags, die du gewählt hast, erhälst du fixen Speicher. Für verschiebbaren musst du $42 gewenden. Zum Verschieben kannst du dann GlobalReAlloc verwenden.
Ich selber arbeite nur mit fixen Speichern. Die arbeiten etwas schneller, und man erlebt keinen ungewollten Überraschungen.

iF, Beitrag=53192, Zeitpunkt=12.07.2009

Nico
Madysa

Die Funktion addr gibt aber nicht die Stringadresse zurück, sondern zeigt auf die ersten Bytes im String, zeigt also auf die Adresse+8.

Natürlich tut sie das. Die APIs -- und in diesem speziellen Falle die Listview-Messages -- interessieren sich nämlich gar nicht für diese Verwaltungslongints, sondern für den Puffer. Worin besteht jetzt konkret der Unterschied, ob ich diesen mit Addr(text$) und len(text$) oder mit bereich# und SizeOf(bereich#) bereitstelle?

EDIT:
@Frank: Davon habe ich schon gelesen, aber ich war mir nicht sicher, wie weit M$ dieses "moveable" fasst. Denen kann man also auch neue Adressen zuweisen? Die Win32.hlp schweigt sich darüber aus und meint nur, mit GlobalReAlloc können Eigenschaften und Größe verändert werden.

Nico Madysa

Frank
Abbing

Denen kann man also auch neue Adressen zuweisen? Die Win32.hlp schweigt sich darüber aus und meint nur, mit GlobalReAlloc können Eigenschaften und Größe verändert werden.

Die Adresse wird sich ändern müssen, wenn die neue Grösse nicht mehr in den ursprünglichen Puffer passt. Ob das auch so durchgezogen wird oder eine Fehlermeldung ausgegeben wird, musst du selber testen, weil ich - wie gesagt - GlobalAlloc nur mit festem Speicher benutze.

Dieter
Zornow

Also ich habe es mal probiert, das Beispiel in dem Aaahen kam habe ich abgeändert und es geht bei mir einwandfrei. Hoffe das hängt nicht mit dem Betriebsystem zusammen.
Kompilieren Markieren Separieren

whileloop 0,len(d$,"x0Dzx0Az")-1

    a$ = SubStr$(d$,&loop+1,"x0Dzx0Az")+"zz"  DIES IST DIE BETROFFENE ZEILE
    InsertStringW(hSort&,a$,&loop)

EndWhile

Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2

Dieter
Zornow

Funktioniert bei mir nicht nur mit GlobalAlloc sondern auch mit der undokumentierten DIM Funktion, die Roland jetzt preisgegeben hat. Als Exe und als PRF

Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2

iF, Beitrag=53192, Zeitpunkt=12.07.2009

RGH

Das Beispiel zeigt auch einen mit der dynamischen Stringspeicherverwaltung zusammenhängenden Problemfall.

Das liegt aber nicht an der Speicherverwaltung XProfans, sondern daran, wie Delphi mit Strings umgeht: Ein Leerstring belegt keinen Speicher und kein Speicher hat auch keine Aderesse.
Das kann zum Stolperstein werden, wenn man einen Leerstring mit Addr(s$) an eine API-Funktion gibt, ohne ihn vorher um ein Nullbyte ("z") zu erweitern.

Gruß Roland

Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4

Nico Madysa, Beitrag=53176, Zeitpunkt=10.07.2009

RGH

Das waren jetzt vier Wege, diesen Fehler zu umgehen. Doch hat irgendjemand eine Ahnung, warum er überhaupt auftritt? Jede dieser vier Lösungen (außer vielleicht Nummer 3) sollte eigentlich gar keine Auswirkung haben und doch verhindern sie den Programmabsturz.

Hallo Nico,

eine derartige Beobachtung, dass ein Programmabsturz aufgrund eigentlich recht unsinniger Änderungen mal erfolgt und mal nicht, oder es im Interpreter geht und compiliert nicht oder umgekehrt, deutet oftmals darauf hin, dass es irgendwo im Code eine kleinere Verletzung von Speichergrenzen gibt, die eben manchmal zum Crash führt und manchmal zufällig nicht, je nachdem was an dem Speicherort, an den fälchlicherweise geschrieben wird, vorhanden ist.
Dass es manchmal funktioniert, deutet darauf hin, dass es eine eher kleinere Grenzüberschreitung ist und in manchen Fällen halt eben lediglich Speicher überschrieben wird, der nicht gebraucht wird oder nicht geschützt ist.

Gruß
Roland

Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4

RGH

Und ich habe Deinen Fehler gefunden, Nico:
Kompilieren Markieren Separieren

LVI#.IMASK&= $1
LVI#.ITEXT&= LVI#+36
LVI#.ITEXTMAX& = 200
LVI#.ISUBITEM& = 0

Hier gibst Du die Adresse für den zu lesenden Text mit LVI# + 36 an. Die Struktur LVITEM ist aber nur 36 Bytes groß, das heißt also, die Adresse weist auf das erste Byte nach der Struktur. Die Programmzeile, die den Text ausliest, schreibt ihn natürlich exakt da hin. Dumm nur, dass dies ein nicht geDIMter Speicherbereich ist.

Du könntest jetzt natürlich die Struktur LVITEM um diese 200 Bytes größer machen (ein text#(200) anhängen), oder aber noch einfacher: Du DIMensionierst B# vor dem Erzeugen der Strukturvariable LVI# und gibst B# direkt als Adresse für den Text an. Dann sieht das Ende der Prozedur LoadText so aus:
Kompilieren Markieren Separieren

<...>
Die Substrings jeder Zeile sind mit einem Semikolon getrennt
Set("ListDel",";")
Das Sortier-Listview wird ins Anzeigelistview übertragen
Aus einer Spalte werden zwei
Dim b#,200
var LVI# = New(LVITEM)
LVI#.IMASK&= $1
LVI#.ITEXT&= B#
LVI#.ITEXTMAX& = 200
LVI#.ISUBITEM& = 0

whileloop 0, Getcount(hSortDP&) -1

    LVI#.ITEM& = &loop
    u_SendMessageW(hSortDP&,$1073,&loop,LVI#)Text auslesen
    d$ = Char$(b#,0,sizeof(b#))In Stringvariable schreiben
    InsertStringW(hList&,d$,&loop)übertragen

EndWhile

Dispose LVI#
Dispose B#

... und alles läuft rund!

Gruß
Roland

Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4

Dieter
Zornow

Oh ja richtig, ich hatte das Nico gesagt und dabei vergessen, dass meine Structur um pauschal 512 für Text erweitert ist, deshalb schreibe und lese ich immer direkt hinter der eigentliche Structur

Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2

Nico
Madysa

Es ist immer wieder erstaunlich, was für simple Lösungen die seltsamsten Ereignisse haben.
Kompilieren Markieren Separieren

 $H Messages.ph
var id% = 1
Struct CREATESTRUCT = lpCreateParams&, hInstance&, hMenu&, hwndParent&, cy%, cx%, y%, x%, style&, lpszName&, lpszClass&, dwExStyle&
Struct LVCOLUMN = Mask&, FMT&, CX&, Text&, cchTextMaxLen&, Subitem&
Struct LVITEM = IMASK&, ITEM&, ISUBITEM&, State&, StateMask&, ITEXT&, ITEXTMAX&, IIMAGE&, ILPARAM&
Def GlobalAlloc(2) !"KERNEL32","GlobalAlloc"
Def GlobalFree(1) !"KERNEL32","GlobalFree"

proc UTF

    parameters text$
    declare b#
    Dim b#,2*len(text$)+2
    StringW b#,0 = text$
    text$ = Char$(b#,0,SizeOf(b#)-2)
    return text$

endproc

proc CreateW

    if %pCount > 10

        parameters Class$,Name$,style&,x%,y%,dx%,dy%,pWnd&,pid%,hInst&,exstyle&

    else

        parameters Class$,Name$,style&,x%,y%,dx%,dy%,pWnd&,pid%,hInst&
        var exstyle& = 0

    endif

    Class$ = UTF(Class$)
    Name$ = UTF(Name$)
    var cs# = New(CREATESTRUCT)

    With cs#

        .lpCreateParams& = SizeOf(cs#)
        .hInstance& = hInst&
        .hMenu& = if(u_IsMenu(id%),id%,0)
        .hwndParent& = pWnd&
        .cy% = dy%
        .cx% = dx%
        .y% = y%
        .x% = x%
        .style& = style&
        .lpszName& = Addr(Name$)
        .lpszClass& = Addr(Class$)
        .dwExStyle& = exstyle&

    EndWith

    var handle& = u_CreateWindowExW(exstyle&,Addr(Class$),Addr(Name$),style&,x%,y%,dx%,dy%,pWnd&,id%,hInst&,cs#)
    inc id%

    ifnot handle&

        Class$ = WinError$(%WinError)
        MessageBox("Es trat folgender Fehler auf:
        " + Class$,"F E H L E R !!!",4096)

    endif

    Dispose cs#
    return handle&

endproc

subproc Create.GridBoxW

    parameters pWnd&,def$,stl%,x%,y%,dx%,dy%
    declare s$
    var hList& = CreateW("SysListView32","",$50000009 + stl%,x%,y%,dx%,dy%,pWnd&,0,%hInstance,$200)
    u_SendMessageW(hList&,$1036,0,$00000023)
    var LVC# = New(LVCOLUMN)

    With LVC#

        .Subitem& = 0
        .MASK& = $7

        whileloop 0,(len(def$,";")  3) - 1

            s$ = SubStr$(def$,3*&loop + 1,";")
            .TEXT& = Addr(s$)
            .FMT&  = val(SubStr$(def$,3*&loop + 2,";"))
            .CX&   = val(SubStr$(def$,3*&loop + 3,";"))
            .cchTextMaxLen& = len(s$)
            u_SendMessageW(hList&,$1061,&loop,LVC#)

        EndWhile

    EndWith

    Dispose LVC#
    return hList&

endproc

proc InsertStringW

    parameters pList&,s$,index%
    declare ss$,palloc&
    var LVI# = New(LVITEM)
    var d$ = UTF(Get("ListDel"))

    With LVI#

        .IMASK&=$1
        .ITEM& = index%

        whileloop len(s$,d$)

            ss$ = SubStr$(s$,&loop,d$) + "zz"
            palloc& = GlobalAlloc($40,len(ss$))
            Char palloc&,0 = ss$
            .iText& = palloc&
            .ITEXTMAX& = len(ss$)
            .ISUBITEM& = &loop - 1

            ifnot &loop - 1

                u_SendMessageW(pList&,$104D,index%,LVI#)

            else

                u_SendMessageW(pList&,$104C,index%,LVI#)

            endif

            GlobalFree(palloc&)

        EndWhile

    EndWith

endproc

proc LoadText

    parameters d$
    case d$ = "" : return
    declare b#,t$,tt$ , a$
    Die CSV-Datei wird eingelesen
    Dim b#,FileSize(d$)
    BlockRead(d$,b#,0,SizeOf(b#))
    d$ = Char$(b#,2,SizeOf(b#)-2)
    Dispose b#
    Die Zeilen werden im Sortier-Listview alphabetisch geordnet

    whileloop 0,len(d$,"x0Dzx0Az")-1

        a$ = SubStr$(d$,&loop+1,"x0Dzx0Az") DIES IST DIE BETROFFENE ZEILE
        InsertStringW(hSort&,SubStr$(d$,&loop+1,"x0Dzx0Az"),&loop)

    EndWhile

    Die Substrings jeder Zeile sind mit einem Semikolon getrennt
    Set("ListDel",";")
    Das Sortier-Listview wird ins Anzeigelistview übertragen
    Aus einer Spalte werden zwei
    Dim b#,100
    var LVI# = New(LVITEM)
    LVI#.IMASK&= $1
    LVI#.ITEXT&= b#
    LVI#.ITEXTMAX& = 200
    LVI#.ISUBITEM& = 0
    Bereich freimachen

    whileloop 0, Getcount(hSort&) -1

        LVI#.ITEM& = &loop
        clear b#
        u_SendMessageW(hSort&,$1073,&loop,LVI#) Text auslesen
        d$ = Char$(b#,0,SizeOf(b#))In Stringvariable schreiben
        InsertStringW(hList&,d$,&loop)übertragen

    EndWhile

    Dispose LVI#,b#

endproc

declare hUser&,hGDI&,hKrnl&
declare hSort&,hList&
cls
var font& = Create("Font","Times New Roman",16,0,0,0,0)
hUser& = ImportDLL("USER32","u_")
hSort& = Create("GridBoxW",%hWnd,UTF("Sortieren")+";0;100",$10,0,0,0,0)
ShowWindow(hSort&,0)
hList& = Create("GridBoxW",%hWnd,UTF("Deutsch")+";0;300;"+UTF("Polnisch")+";2;300",$00,0,0,width(%hWnd),height(%hWnd))
SetFont hList&,font&
WindowTitle "Bitte warten, Wortliste wird geladen ..."
Format
"Wort1;Wort2
Wort3;Wort4;..."
LoadText LoadFile$("Quelldatei laden ...","deupol.txt")
WindowTitle "Je 100 deutsche und polnische Wörter (ESC um zu sichern)"

whilenot IsKey(27)

    waitinput

wend

FreeDLL hUser&
FreeDLL hGDI&
FreeDLL hKrnl&
DeleteObject font&
end

Danke euch allen für eure Geduld und Hilfe.

Nico Madysa