Probiere ich alles mal am Montag Abend aus. Da kann ich auch mal einen Test laufen lassen um zu ermitteln wie groß die Maps nach meiner Methode sein müssen. Mit Message und dann punktgenau allokieren ist natürlich viel eleganter.
XProfan X5
-
-
-
Ich denke auch, daß wir mit den vielen Möglichkeiten von XProfan
auf eine zufriedenstellende Lösung kommen. -
Geiler Scheiß. Nur leider lässt sich das nur sehr schwer eine allgemeine Funktion basteln:
Code
Alles anzeigenproc FindFiles Parameters handle&,folder$,mask$ declare strg$,map$,b#,map& windowstyle 2048 cls ChDir folder$ AddFiles mask$,1 strg$=Move("ListToStr","|") UserMessages $1001 sendmessage(handle&,$1000,%hWnd,Len(strg$)) while 1 waitinput if %UMessage=$1001 map&=FileMap("Open","FindFileMap") dim b#,Len(strg$)+1 b#=FileMap("Map",map&) String b#,0=strg$ Dispose b# FileMap("Close",map&) sendmessage(handle&,$1002,0,0) Break endif endwhile endproc declare size&,liste&,liste2&,map&,q#,isopen% cls liste&=Create("Listbox",%hWnd,0,0,0,Width(%hWnd,0),Height(%hwnd,0)-80) liste2&=Create("Listbox",%hWnd,0,0,Height(%hWnd,0)-80,Width(%hWnd,0),80) UserMessages $1000,$1002 PExec("|FindFiles",%hWnd,"D:\\XProfan\\XProfan","*.*") PExec("|FindFiles",%hWnd,"D:\\XProfan\\Projekte\\OSU-Tool","*.*") PExec("|FindFiles",%hWnd,"D:\\XProfan\\Projekte\\CloudSync","*.*") PExec("|FindFiles",%hWnd,"D:\\XProfan\\Projekte\\Gamsav","*.*") while 1 if GetCount(liste2&) and Not(isopen%) size&=Val(SubStr$(GetString$(liste2&,0),1,"|"))+1 map&=Create("FileMap","FindFileMap",Val(SubStr$(GetString$(liste2&,0),1,"|"))+1) sendmessage(Val(SubStr$(GetString$(liste2&,0),2,"|")),$1001,0,0) Inc isopen% endif waitinput select %UMessage caseof $1000 AddString(liste2&,Str$(&ULPARAM)+"|"+Str$(&UWParam)) caseof $1002 dim q#,size& q#=FileMap("Map",map&) sendmessage(liste&,$B,0,0) Clearlist Move("StrToList",String$(q#,0),"|") Move("ListToHandle",liste&) sendmessage(liste&,$B,1,0) FileMap("Close",map&) Dispose q# DeleteString(liste2&,0) Clear isopen% endselect endwhile
-
Dein Code muß ich mir mal anschauen.
Auf den ersten Blick :
SendMessage ist dazu gedacht, Messages an ein Fenster oder bestimmtes Control
(Buttons, Editboxen, Listboxen usw.) zu senden. Controls sind in Windows auch
Fenster.
Und NICHT an eine Zeile, bzw. Teil eines Strings, die/der mit GetString$ ermittelt wurde.
Erwartet also unbedingt ein HANDLE. Da kommt natürlich auch kein Fehler. Der Aufruf
verhallt in den Weiten des Computerspeichers, weil Windows kein Handle findet.Also, nochmals Code durchsehen.
Wie man jetzt einem Prozess eine Message schicken kann, weiß ich nicht.
Das Fenster, das du im Prozess verwendest, ist ja dem Hauptprogramm
nicht bekannt (ungefähr das gleiche, wie eine lokale Variable in einer PROC).Ich kenne es jetzt nur anders rum. Der Prozess sendet dem Fenster, dessen Handle
man per pExec mitgibt, eine Message.
Mal schauen, ob es da eine Möglichkeit, außer Map, gibt.Mit Map + FindWindow hätte ich da was :
Die Übergabe geht natürlich auch mit einem Editfeld. Das könnte man ja
bei Bedarf auch mit ShowWindow ausblenden.Code
Alles anzeigen$H Messages.PH Declare h&,hd&,hd1&,ende&,wert&,wert1&,b_send&,text$,tadr&, hFileMap& declare pointer# Declare String myArray[] Declare Handle ZielFenster, edit1& Struct Daten = w&, w1&, zk$(256) dim pointer#,Daten myArray[0] = "Klaus hat Äpfel gekauft !" myArray[1] = "Rosi hat Rosinen gekauft !" myArray[2] = "Kai hat Pflaumen gekauft !" Proc Prozess parameters win&, hd&,hd1&, edit& Declare pointer#, edit2& declare w&,w1&,ende&, hFileMap& Struct Daten = w&, w1&, zk$(256) dim pointer#, Daten windowtitle "empfang" window 10,10 - 350, 200 edit2& = Create("Edit", %HWnd, "", 100, 10,80, 25) ende& = 0 UserMessages $1000 whilenot ende& Case GetText$(win&) = "" : ende& = 1 sleep 1 GetMessage If %UMessage = $1000 hFileMap& = FileMap("Open", "Test") If hFileMap& pointer# = FileMap("Map", hFileMap&) locate 3,1 print " " + str$(pointer#.w&) + " " setText hd&, str$(pointer#.w&) locate 5,1 print " " + str$(pointer#.w1&) + " " setText hd1&, str$(pointer#.w1&) Locate 7, 2 Print " " Locate 7, 2 Print " " + pointer#.zk$ FileMap("Close", hFileMap&) EndIf SetText edit2&, GetText$(edit&) EndIf endwhile Dispose pointer# endproc windowtitle "send" window 10,300-200,200 hd& = create("Text", %hWnd, "", 20, 10, 60, 20) hd1& = create("Text", %hWnd, "", 20, 35, 60, 20) edit1& = Create("Edit", %HWnd, "", 100, 20, 80, 25) b_send& = Create("Button",%hWnd,"send", 10, 65, 80, 24) hFileMap& = Create("FileMap", "Test", SizeOf(pointer#)) h&=pExec("|Prozess",%HWnd, hd&,hd1&, edit1&) sleep 500 ZielFenster = FindWindow("empfang") ende& = 0 Randomize UserMessages $1000 whilenot ende& waitinput If Clicked(b_send&) hFileMap& = FileMap("Open", "Test") If hFileMap& pointer# = FileMap("Map", hFileMap&) wert&=wert&+1 wert1&=wert1&+5 pointer#.w& = wert& pointer#.w1& = wert1& pointer#.zk$ = myArray[Rnd(3)] FileMap("Close", hFileMap&) SetText edit1&, pointer#.zk$ PostMessage(ZielFenster, $1000, 0, 0) EndIf endif endwhile Dispose pointer# end
Vielleicht kannst du ja daraus was machen, indem du dir den Namen der Filemap per Editfeld holst. -
Heinz, jetzt bin ich sauer. Hast du den Code mal ausprobiert? Natürlich mit angepassten Suchpfaden?
Message $1000 sendet das Zielfenster und die benötigte Größe. Die werden in der Liste gespeichert, weil die nächste Message auch eine $1000 sein kann und die nicht verloren gehen kann. Dann wird die Liste nacheinander abgearbeitet. Message $1001 geht zurück an den Client, deshalb das Handle wieder mit GetString auslesen. Kein Murks und keine Zauberei. Message $1002 vom Clienten zeigt den Host, dass er den String übertragen hat.
Message an Prozess funktioniert nicht, das habe ich probiert. Bei mir funktioniert mein Programm einwandfrei, egal wie viele Suchvorgänge ich simultan starte.
-
Das ist schon richtig so. Heinz hat einfach übersehen, daß zuvor das Handle in die Liste geschrieben wurde. Da kann man es aber nur in Stringform unterbringen
Gruß Volkmar
-
Bin immer noch wütend!
-
Brauchst nicht gleich sauer zu sein.
Das habe ich tatsächlich übersehen, sorry.
Wenn ich so empfindlich wäre, da wäre ich schon seit Jahren
nicht mehr hier anwesend.Bei mir funktioniert mein Programm einwandfrei, egal wie viele Suchvorgänge ich simultan starte.
Dann ist ja alles gut und für mich das Thema abgeschlossen.
-
Ich hab mich mehr geärgert, dass du den Code kritisierst ohne ihn probiert zu haben. Aber das Thema ist durch, auf zum nächsten.
Neue Proc "AddFilesASync". Sie funktioniert wie "AddFiles" inklusive Modus. Mehrere Aufrufe werden mit dem Listentrennzeichen getrennt. Die Proc achtet auch darauf, dass eventuell schon vergebene UserMessages wiederhergestellt werden. Das Programm hält nicht an während die Suchvorgänge durchgeführt werden, aber die Proc selbst übernimmt die Kontrolle bis alle Vorgänge beendet sind. Eine wirklich asynchrone Funktion muss man dann selbst anpassen und tief ins Programm einbinden. Für Verbesserungsvorschläge bin ich natürlich offen.
Code
Alles anzeigenproc FindFiles Parameters handle&,folder$,mask$,modus% declare strg$,map$,b#,map& ifnot DirExists(folder$) sendmessage(handle&,$1000,0,0) end endif windowstyle 2048 cls ChDir folder$ AddFiles mask$,modus% if GetCount(0)=0 sendmessage(handle&,$1000,0,0) end endif strg$=Move("ListToStr","|") UserMessages $1001 sendmessage(handle&,$1000,%hWnd,Len(strg$)) while 1 waitinput if %UMessage=$1001 map&=FileMap("Open","FindFileMap") dim b#,Len(strg$)+1 b#=FileMap("Map",map&) String b#,0=strg$ Dispose b# FileMap("Close",map&) sendmessage(handle&,$1002,0,0) Break endif endwhile endproc Proc AddFilesASync Parameters maske$,modus% declare messages$,ld$,liste&,temp$,count%,isopen%,size&,map&,q# messages$="," whileloop $1000,$1002 if IsUserMessage(Str$(&loop)) messages$=messages$+Str$(&Loop)+"," else UserMessages &Loop endif endwhile liste&=Create("List",0) ld$=Get("ListDel") whileloop Len(maske$,ld$) temp$=SubStr$(maske$,&loop,ld$) PExec("|FindFiles",%hWnd,Left$(temp$,Len(temp$)-Len(SubStr$(temp$,-1,"\\"))),SubStr$(temp$,-1,"\\"),modus%) Inc count% endwhile while 1 if GetCount(liste&) and Not(isopen%) size&=Val(SubStr$(GetString$(liste&,0),1,"|"))+1 if size&=1 DeleteString(liste&,0) Dec count% else map&=Create("FileMap","FindFileMap",Val(SubStr$(GetString$(liste&,0),1,"|"))+1) sendmessage(Val(SubStr$(GetString$(liste&,0),2,"|")),$1001,0,0) Inc isopen% endif endif case count%=0:Break waitinput select %UMessage caseof $1000 AddString(liste&,Str$(&ULPARAM)+"|"+Str$(&UWParam)) caseof $1002 dim q#,size& q#=FileMap("Map",map&) sendmessage(liste&,$B,0,0) Move("StrToList",String$(q#,0),"|") sendmessage(liste&,$B,1,0) FileMap("Close",map&) Dispose q# DeleteString(liste&,0) Clear isopen% Dec count% endselect endwhile whileloop $1000,$1002 casenot InStr(","+Str$(&Loop)+",",messages$):Usermessages -1*&Loop endwhile DestroyWindow(liste&) endproc declare liste& cls liste&=Create("Listbox",%hWnd,0,0,0,Width(%hWnd,0),Height(%hwnd,0)) AddFilesASync "D:\\XProfan\\Projekte\\OSU-Tool\\*.prf|D:\\XProfan\\Projekte\\CloudSync\\*.prf|D:\\XProfan\\Projekte\\Gamsav\\*.prf",1 Move("ListToHandle",liste&) SetText %hWnd,"Fertig" while 1 waitinput endwhile
-
Mir ist gerade noch ein Fehler aufgefallen, die Zeilen
und
müssen raus bzw. vor/nach
rein. Vielleicht kann das ein Moderator ändern.
Ein weiterer Schwachpunkt ist, dass die Anzahl der Ergebnisse nicht über 252144 liegen darf. Gegebenfalls muss man den Code weiter anpassen.
Anmerkung: Ich habe den Code gerade etwas modifiziert und auf Arbeit ausprobiert. Ich habe an 7 Orten im Netzwerk insgsamt 603423 Dateien finden lassen. Der Originalcode mit aufeinanderfolgenden Suchen braucht etwa 57 Sekunden. Mit parallelen Suchen waren es nur noch etwa 21 Sekunden. Natürliche ist Reihenfolge der gefundenen Dateien dann anders. Da ist jeder selbst dafür verantwortlich den Code anzupassen. Ich stelle morgen eine finale Version mit optionalem dritten Parameter hier rein, der ein Grid oder eine GridBox sein kann, damit der Überlauf bei Element 252145 nicht stattfinden kann.
-
Hab mal den Quellcode entsprechend geändert.
Gruß Volkmar
-
Code
Alles anzeigenproc FindFiles Parameters handle&,folder$,mask$,modus% declare strg$,map$,b#,map& ifnot DirExists(folder$) sendmessage(handle&,$1000,0,0) end endif windowstyle 2048 cls ChDir folder$ AddFiles mask$,modus% if GetCount(0)=0 sendmessage(handle&,$1000,0,0) end endif strg$=Move("ListToStr","|") UserMessages $1001 sendmessage(handle&,$1000,%hWnd,Len(strg$)) while 1 waitinput if %UMessage=$1001 map&=FileMap("Open","FindFileMap") dim b#,Len(strg$)+1 b#=FileMap("Map",map&) String b#,0=strg$ Dispose b# FileMap("Close",map&) sendmessage(handle&,$1002,0,0) Break endif endwhile endproc Proc AddFilesASync'Flags&: 1=Neuzeichnen nicht verändern, 2=Stringrückgabe (handle&=0) Select %PCount CaseOf 4 Parameters maske$,modus%,handle&,flags& CaseNot TestBit(flags&,0):SendMessage(handle&,$B,0,0) CaseOf 3 Parameters maske$,modus%,handle& SendMessage(handle&,$B,0,0) var flags&=0 CaseOf 2 Parameters maske$,modus% var handle&=0 var flag&=0 OtherWise Return -1 EndSelect declare messages$,ld$,liste&,temp$,count%,isopen%,size&,map&,q#,return$ messages$="," whileloop $1000,$1002 if IsUserMessage(Str$(&loop)) messages$=messages$+Str$(&Loop)+"," else UserMessages &Loop endif endwhile liste&=Create("List",0) ld$=Get("ListDel") whileloop Len(maske$,ld$) temp$=SubStr$(maske$,&loop,ld$) PExec("|FindFiles",%hWnd,Left$(temp$,Len(temp$)-Len(SubStr$(temp$,-1,"\\"))),SubStr$(temp$,-1,"\\"),modus%) Inc count% endwhile while 1 if GetCount(liste&) and Not(isopen%) size&=Val(SubStr$(GetString$(liste&,0),1,"|"))+1 if size&=1 DeleteString(liste&,0) Dec count% else map&=Create("FileMap","FindFileMap",Val(SubStr$(GetString$(liste&,0),1,"|"))+1) sendmessage(Val(SubStr$(GetString$(liste&,0),2,"|")),$1001,0,0) Inc isopen% endif endif case count%<1:Break waitinput select %UMessage caseof $1000 AddString(liste&,Str$(&ULPARAM)+"|"+Str$(&UWParam)) caseof $1002 dim q#,size& q#=FileMap("Map",map&) If TestBit(flags&,1) Return$=Return$+"|"+String$(q#,0) ElseIf handle&=0 Move("StrToList",String$(q#,0),"|") Else Clearlist 0 Move("StrToList",String$(q#,0),"|") Move("ListToHandle",handle&) EndIf FileMap("Close",map&) Dispose q# DeleteString(liste&,0) Clear isopen% Dec count% endselect endwhile whileloop $1000,$1002 casenot InStr(","+Str$(&Loop)+",",messages$):Usermessages -1*&Loop endwhile DestroyWindow(liste&) Case TestBit(flags&,1):Return Del$(Return$,1,1) Case (handle&<>0) And Not(TestBit(flags&,0)):SendMessage(handle&,$B,1,0) endproc
Aufruf:
AddFilesASync S,N1[,N2[,N3]]Entweder mit 2 Parametern wie bei AddFiles, oder mit einem dritten Parameter als Handle einer Gridbox/ListBox etc., die die Ergebnisse aufnimmt. Es ist auch ein dritter Parameter möglich (0=kein Einfluss, 1=Neuzeichnen des Handles von N2 nicht verändern, 2=Rückgabe der Ergebnisse als String (dann wird N2 ignoriert)).
-
Hallo zusammen,
Zwei Sachen:
- Ich wollte mal nachfragen, wann XProfan 5 in etwa kommen wird?
- Hier habe ich gesehen das es ein Xprofan x64 gibt. Könnte man davon eine aktuelle Fassung haben?
Freue mich auf ein Feedback!
Beste Grüsse,
AndréNebenbei: Wir haben soeben diese kleine aber feine Zeichnungsverwaltung, komplett mit Profan und SQLite, fertig gemacht.
-
Soweit ich weiß nein und nein.
-
Hier habe ich gesehen das es ein Xprofan x64 gibt. Könnte man davon eine aktuelle Fassung haben?
Eine Version, die den Funktionsumfang (mit ein paar Ausnahmen) von X3 hat, bekommst du hier :
https://xprofan.net/intl/de/xprofan/freeprofan/
War wohl die letzte Version. Eine 64-Bit Version mit Delphi geschrieben, wird es auch nicht geben.
Dazu ist die 64Bit Version von Delphi schweineteuer, somit fällt das auch flach.An eine Version 5 glaube ich eigentlich nicht mehr. Dafür nutzen es momentan nur wenige, sodaß sich
der Aufwand nicht lohnt. Es ist auch abhängig, ob Roland genügend Freizeit daür hat. Schließlich gehen
Arbeit und Familie vor.Was ich mir noch wünschen würde, wäre noch eine weitere Subscription.
Da wären ja noch einige Baustellen, die bereits schon in den anderen 2 Foren angesprochen wurden,
fertig zu stellen. Etwa Drag & Drop, mit dem auch Anfänger zurecht kommen, mehr Netzwerkfunktionalität
und das eine oder andere noch. Da käme bestimmt noch eine gut bestückte Liste mit kleinen Wünschen,
für die es sich lohnen würde. Lohnen würde sich das nicht geldlich sondern rein arbeitstechnisch und um
XProfan noch etwas am Leben zu halten.Ich hatte ja gehofft, daß in der CORONA - Zeit, ein paar mehr neue Leute, die zuhause bleiben müssen,
Interesse daran hätten. -
-
Sorry, daß ich den Thread mal wieder hoch hole.
Was mir in den letzten Monaten aufgefallen ist :
Wenn ich (und andere) einen Quellcode ins Forum
reinstelle, sind wenig später über 100 Zugriffe zu
sehen, abzüglich meiner 5 - 10 Zugriffe für Verbesserungen
des Quellcodes bzw. Antworten.
Folglich scheint ja immer noch ein Interesse an XProfan
bzw. Profan zu bestehen. Was sollte auch jemand sonst mit
mit dem Quellcode anfangen, außer mal auszuprobieren oder
bestimmte Codeteile für seine Projekte zu nutzen.
Vielleicht sollte man mal eine Abfrage starten, um zu ermitteln
wie hoch das Interesse an einer folgenden Version X5, einem
Update oder Subscription ist. Evtl. könnte das RGH etwas
ermutigen, sein tolles XProfan-Projekt weiter zu führen.
Daß es sich finanziell für ihn nicht lohnen wird, ist ja ein
anderes Thema. Zumindest bliebe XProfan noch eine
Zeitlang am Leben, zumindest, solange 32 Bit von Windows
unterstützt wird.
Vielleicht könnte der Moderator hier mal so eine Liste online
stellen, wo man bei Interesse anklicken kann.
-
Danke Volkmar, habe soeben mal meine Klicks gemacht.
Ich selber wußte nicht, wie man sowas hier einstellt.
Das ist schon mal ein schöner Anfang.
Interessiert mich halt mal, da so viele Zugriffe auf meine
Werkzeugliste stattfanden. Was dabei heraus kommt,
werden wir ja sehen.
PS: Kannst du noch eine Option "Ja, ich wünsche mir ein Update"
hinzu fügen ? Ist ja schließlich auch ein Argument für XProfan.
Roland könnte ja auch zuerst einen kostengünstigen Patch mit
neuen Funktionen bzw. Befehlen zur Verfügung stellen. Macht dann
für ihn nicht soviel Arbeit.
-
Ich habe die Frage mal hinzugefügt, aber wir, da wir schon abgestimmt haben, können das nicht mehr anklicken. Deshalb mal an dieser Stelle: Ja, das würde ich auch begrüßen, wenn da auch mal ein Update machbar wäre.
Gruß Volkmar
-
Vielleicht könntest du die Umfrage etwas höher hier im Forum platzieren,
direkt als neuer Thread bei Anregungen und Bugreports.
Hier, ganz unten in dem alten Thread sieht das kaum jemand. Das ist so,
als wenn das Superangebot vom ALDI ganz hinten in einer kleinen Ecke
steht. Da geht auch so mancher nicht vorbei.
Vielleicht wäre auch noch eine Liste nicht schlecht, wo man mit jeweils einer Zeile
seine(n) Wunsch - Funktion / Befehl reinschreiben kann. Wenn da etwas zusammen
käme, bekräftigt das noch obige Umfrage.
-
Jetzt mitmachen!
Sie haben noch kein Benutzerkonto auf unserer Seite? Registrieren Sie sich kostenlos und nehmen Sie an unserer Community teil!