Überflüssige Algorithmen (Programmierabfall)

[p. specht]

Hier ein Beispiel, welches unfertige Zeug in dieser Rubrik landen sollte:

' Es gibt ja Programme, wo Schaltflächen nicht rechtwinkelig sind,
' sondern z.B. Polygone. Diese kann man stets in eine Menge Dreiecke
' zerlegen, für die man dann recht einfach INNEN und AUSSEN ermitteln kann.
WindowTitle "Maus im Dreieck?":cls
declare x!,y!,x1!,y1!,x2!,y2!,x3!,y3!
x1!=240:y1!=40: x2!=400:y2!=200: x3!=240:y3!=300

proc PTEST:parameters x!,y!:declare fab!,fca!,fbc!
fAB!=(y!-y1!)*(x2!-x1!)-(x!-x1!)*(y2!-y1!)
fCA!=(y!-y3!)*(x1!-x3!)-(x!-x3!)*(y1!-y3!)
fBC!=(y!-y2!)*(x3!-x2!)-(x!-x2!)*(y3!-y2!) 
return ((fAB!*fBC!)>0) & ((fBC!*fCA!)>0)
endproc

proc TRIANG:parameters x1!,y1!,x2!,y2!,x3!,y3!
usepen 0,1,@rgb(255,0,0):line x1!,y1!-x2!,y2!
line x2!,y2!-x3!,y3!:line x3!,y3!-x1!,y1!
endproc

triang(x1!,y1!,x2!,y2!,x3!,y3!)'Init
print:print "ESC beendet.": Print : print "Deine Maus ist jetzt..."
WHILENOT %Key=27:settimer 100:WaitInput 'Main
  x!=%MouseX:y!=%Mousey
  IF PTest(x!,y!):Locate 10,10:Print "Innen "
  ELSE:Locate 10,10:Print "Aussen":ENDIF
ENDWHILE 'Exit
killtimer
End

Also für die Praxis unwichtiges, bereits gelöstes etc., wo´s für den
einen oder anderen noch interessant ist, wie es funktioniert.
Etwa wie ein Computer einen Kreis zeichnet, oder eine Linie.
Aber das ist dann eine weitere Geschichte.

Gruss


Edit:
Peters Übersicht zu diesem Thread:

------------------------------------------------------------------------------------
Inhaltsverzeichnis:
------------------------------------------------------------------------------------
Allgemeines
---------------
#30 Zusammenstellung: Griechische Formelzeichen
#100 Vier neue SI-Größenordnungs-Präfixe (Stand 2010)
#31 Links: Patentrecht und Urheberrecht
#33 Kappa? =elektrische Leitfähigkeit, Kompressibilität und Isentropenexponent!
#51 Hinweis EXCEL-2007-Bug
#52 Hinweis OpenOffice Calc Bug, wird sicher bald gefixt.
#115 Schicksal von OpenOffice nach Aufkauf durch ORACLE?
#142 Altcode nach Profan: Intel und AMD verlangen viel für Fortran-90-Compiler für Multicore
#143 Hinweis: Nimmste MingGW für Windows oder Linux, 32 oder 64 -Bit, das hat Fortran free!
#145 Hinweis: Alle neueren GCC Compiler (standard unter Linux) unterstützen Fortran 95.
MinGW ermöglicht die Nutzung von GCC unter Windows.
#154 Interessante Links, u.a.: Air Traffic Online
#155 Weitere interessante Onlinedienste
#223 Wir begrüßen Programmmiermüll-Fan Nr. 10.000
#231 Science: Mobiltelefon-Computer mit Wissen der Menschheit. World Future Society

Informatik allgemein
--------------------
#149 Aktuelles: Computer Science Technical Reports; Wiki-Link: "Die 13 Berkley-Zwerge"
#147 Prog "Pausen-Kontroll-Programm zur Überwachung (arbeits)müder Programmierer"
#239 Link: Artikel zu Marvin Minsky: Seele auch nur eine (wenn auch komplexe) Maschine.
#57 Link: ... Timeline_of_algorithms

Unterthema Supercomputing

#153 Thema Aktueller Stand bei Supercomputern 2011

WINDOWS
-------
Unterthema Programmier-Utilities:

#24 Prog Inc-Generator betr. "Wellknown SID's"
#28 Versuchscode "Movable Elements"
#10 Testprog: Kleines "Lernproggie", das versucht unter Vista den eigenen IL zu setzen

Unterthema Sicherheit

#6 Prog: Zombieprozess- und RootKitScanner
#39 Anleitung: Löschen der Spionagedatei index.dat
#41 Hinweise: Geht einfacher: Mit UNLOCKER 1.8.7
#42 Auch per API MoveFileEx() möglich
#43 Dank: FileSnapper wegen des $12019-Fixes für Pipes ausgebessert!
#126 Thema: Cryptographie - aktueller denn je... Seltenes Link auf PGP

#224 Thema: Avira "WebGuard" sieht alles! Kern installiert sich ungefragt.
#226 Schäuble und Oberpullach lassen grüßen...
#228 Beim letzten Update hat AVAST auch einen Web-Guard installieren wollen. Macht es bei Ablehnung aber nicht.

Unterthema Vista & Win7

#159 Trick Vista & Win7: Shift+"Rechte Maustaste" zu "Eingabeaufforderung hier öffnen"
#180 Thema Sicherheitsstufe von ausführbaren Programmen
#181 Thema Berechtigungen unter Vista und Win7
#182 Hinweis: Windows zeigt dir gar nicht, wie das wirklich aussieht.
#183 Thema NTFS-Dateiattribute, ATTRIB, Alternate Data Streams (ADS) & Tools zum Aufspüren
#184 Thema Die (gar nicht so) Einfache Netzwerk- und Dateifreigabe
#185 Thema Benutzerkontensteuerung (UAC) und Datei.manifest - Mechanismus
#186 Thema Virtualisierungssoftware
#191 Hinweis: UAC tut sehr viel mehr als hier erwähnt..Link: Was passiert, wenn man (ab Vista) die UAC deaktiviert?
#193 Thema & Link: Wenn die Zugriffssteuerung (UAC) dreinfunkt
#194 Hinweis: Durch die Sülze von M$ blickt im Prinzip keiner durch!
#195 Hinweis & Links betreffend das aktuelle Microsoft-Dateisystem NTFS
#207 Hinweis: no more Motherboard beep in Win7!
#241 Tipp "Ausführen"-Feld in Win7 einschalten (Ähnlich bei Vista)

Unterthema Konsolenprogramme und Treiberprogrammierung

#242 Hinweis: DOS ist nicht existent, Consolenprogramme sind echtes Windows
#243 Sieht nur so ähnlich aus, klappt aber. Link: Sourceforge-Versuch, ein 64bit-DOS die Beine zu stellen.
#209 ..da kein 64-Bit Treiber für den Lautsprecher!
#210 Wie schreibt man einen Treiber? Link: Demo-Treiber für Win NT samt Sourcecode.
#211 ...Alleine die Signierung wird zu Teuer sein...
#212 Link: Hier hat es wer versucht: 64-Bit-Treiber für Beep
#221 Wenn man etwas weiter liest, gibt es auch ne 64bit Version von dem Treiber, sollte funktionieren...
#215 ...Funktioniert bei Windows7-64 Home Premium leider nicht
#217 32-Bit Treiber lassen sich von einem 64-Bit OS nicht aufrufen <??>
#216 WinXP64-CD rumfliegen (dank MSDNAA). Eine Beep.sys ist zumindest mal drauf
#222 NICHT INSTALLIEREN! Es reicht schon, wenn Viren das umstellen!
#220 In einem 64-Bit OS leider auch (noch?) nicht zur Verfügung: Die ODBC-Treiber!

XProfan
-------
#58 PRINT-Fenster bei Überdeckung (11.2a)
#88 Wer hat aller XProfan-Homepages (Linkliste)
#108 Units
#125 Testprocs: XProfan 11.2a und Rekursionsformeln
#127 Nostalgie: READ/DATA - Ein Griff in die Mottenkiste
#141 Procs: Auskommentieren und Zeilenverbinden am Beispiel CASE: Was zum tüfteln!
#150 Nostalgie: Thread-Programmierung anno dunnemal: zweites Programm parallel starten
#196 Proc "While-lose For-Nextschleifen-Notlösung"
#197 Aufreg:...in eine halbe Proc zu springen ist doch zuviel des Guten!
#198 Chef: WHILELOOP kann schon seit vielen Versionen das Gleiche!
#199 Aber Verschachtelung über 40 bzw. n Whileloops? Nötig weil:
#201 Rekursive Programmierung unbekannter Tiefe - kommt oft vor. Elegante Algorithmen, insb. bei
Verpackungs/Beladungs-Aufgaben! Vgl: Prog "Binärzähler" mit an machen Stellen 5 Zuständen?
#202 Kritik: Brrr...Dann lieber Bedingungen einbauen. Möglichst kein Selbstmodifizierender Code!
#203 Kritiker liefert Beispiel "Sich selbst proragmmierender Code"
#204 203 ist Generator für eine Art COMPILIERBARES EXECUTE!


Mathematik und Ganzzahlenrechnung
---------------------------------

Unterthema Numerische Näherungsverfahren

#3 Prog: In einen älteren Mikroprozessor (6502) sollte "Kubikwurzelfunktion" rein
"NEWTON-RAPHSON"
#9 Prog "Gleichungswaage", Nachricht: Agrawal-Kayal-Saxena AKS-Primzahltest
#35 Thema Formeleditor schreiben: Wäre ganz schön kompliziert! Abhilfe Online!
#38 Info: Lösungen der "Schul"-Polynome im Reellen Zahlenbereich R.
#67 Proc "x=1/tanh(x) iterativ finden"
#69 Tabelle MATHE-SOFTWARE: Wolfram Mathematica, Derive (relativ teuer), MapleV, SciLab...
#92 y = x^x (Sophomore-Funktion);
#94 Aber deren Umkehrfunktion?..."Indikator" x_circa = s / log_10(s)
#95 Double precision Floating Point Variablen ('DpFP') in XProfan:
kleinst- und größte gerade noch darstellbare Zahl ermittelt
#148 Testprog "Die Leibnitz-Reihe konvergiert zu langsam gegen Pi/4"

Unterthema Spezielle Zahlen

#60 Links auf Programme, die Pi auf 2047 +/- 0.5 Stellen genau berechnen
#61 Link: 100000 Stellen von Pi
#62 Rekordhinweise: Pi auf 2.576.980.370.000 Stellen (Prof. Daisuke Takahashi),
Pi, auswendig auf 67890 Stellen
#90 Prog "Collatz-Problem"
#96 Nachricht: Schnellster Multiplikationsalgorithmus für große Integer-Zahlen
Info: Blum-Blum-Shub-Generator

Unterthema Primzahlen

#21 Primzahlen: Link auf Liste der ersten 80.000 Primzahlen im Excel-Format
Info: "Improved AKS"-Algorithmus
#22 Prog "Erathostenes auf Speed: Anzahl der gespeicherten Primzahlen"
#27 EINSCHUB: Geschichtliches, Code "Primzahlen, binär betrachtet"
#138 Prog "Specht´s Primel (c)2011ff" = Fraktal: Deterministisch, und doch Chaos

Unterthema Kombinatorik

#18 proc "Fakultaet", "Base", "GGT", "KGV", "Prim", "Frac", "Quersumme" -
#19 Prog "Bruchkürzer"; Höchste Zahl N, deren FAKULTÄT N! sich in XProfan11 einfach berechnen lässt: 170
Stirling-Formel (bzw. deren Float-Umsetzung) unterschätzt Wert. Besser StientjesLN4!
Prog "Fakultätenformeln im Vergleich"
#59 Prog "Integerzahl nach Graycode (z.B. Drehgeber-Emulator)"
#139 Prog "Lexikographisch aufsteigende Permutation eingegebener Worte"
#206 Prog "ALGORITHM L : LexicalComb(N,k) .. 1<=k<=N"
#229 Prog N faktorielle: N !, auch 'N Fakultät' genannt: "facto(N): N-factorial in Number Base B"
#230 Prog N-über-k Funktion (Binomialkoeffizienten des Pascal´schen Dreiecks) "BinCoeff(n over k) = n!/((n-k)!*k!)"
#233 Prog Kombinationen der Breite k aus N Elementen "Algorithm T","Algorithm X-7"
#239 Links: Stand der Kombinatorik; Richard P. Stanley

Unterthema Operations Research und Ganzzahlige Optimierung

#123 Thema: Grundsätzliche Pack-Varianten ermitteln (und letztlich optimieren)
#146 Test-Prog "THE SQUARE ASSIGNMENT PROBLEM SOLVER" (Übersetzt aus Fortran 74)


(Unscharfe) Stringsuche
-----------------------
#102 Unscharfe String-Vergleiche: "Levenshtein-Distanz"
#104 Link .prc-Testdatei "Kölner Phonetik"
#111 Frank = Frankie, aber <> Schrank: Ist doch was!
#112 Ja: Schneckenlangsamer Müll
#113 Testcodegenerator für Kölner Phonetik
#114 Aktueller Stand bei (allgemeiner) Textähnlichkeitsuche: MCWPA Algorithmus
#118 "Anagrammdistanz": Zeichenpositionsunabhängiger Wortvergleich
#119 Thema Ähnlichkeitsmaße im Data Mining, Algo BEREINIGTE HAUSNUMMERN


Sortieren
---------
#161 Prog "NONREKURSIVES QUICKSORT"
#163 Prog "NONREKURSIVES FLOATWERTE-QUICKSORT"
Prog "NONREKURSIVES STRING-QUICKSORT"
#166 Quicksort einer der besten Sorts für Durschschnittsdaten (Sortieren ist Mega-Out!)
#167 Welchen Algo z.B. benutzen Listviews?
#168 Thema: BurstSort, eine verbesserte Variante des "American flag sort" (vom Typ BucketSor)
Link: BurstSort C++ Bibliothek auf Sourceforge
#169 Durch Verwendung von Patricia-Trie-Techniken (Trie = reTRIEval-Technik "Practical Algorithm to Retrieve Information Coded in Alphanumeric", kein Schreibfehler in "tree"!) kann Speicherbedarf nochmal reduziert werden.
#170 Mitte 2006 wurde die Sortiergeschwindigkeit dann nochmals verdoppelt: CP-Burstsort ist doppelt so schnell
#187 Sortmethode bei Listview doch nicht wählbar.
#188 Hinweis & Link: LVM_SORTITEMS Message (Windows) wahrscheinlich sinnvoller
#240 Tipp: Ziemlich clever: Konsolenprogramm Sort.exe


Datum und Zeit
--------------
#122 Prog WOCHENTAGSBERECHNUNG "ZELLER´s KONGRUENZ"
#120 Hinweis: Missverständliches time$(1)
#121 Ab XProfan X2 (=12) wird time$(1) durch dt("getTime", 1) ersetzt


Mausprogrammierung
------------------
#1 Prog: "Cursor in oder ausserhalb Dreieck?"
#172 Beta-Prog "CrazyMouse 1.0beta"
#173 Trackball hat nur zwei Tasten, wird als 5-Tastige Maus erkannt?
#176 Maus mit Sondertasten: #define WM_XBUTTONDOWN 0x020B
#define WM_XBUTTONUP 0x020C WM_XBUTTONDOWN Message (Windows)
#178 Im Highword von wParam erhälst du Infos, welcher der beiden X-Buttons gedrückt wurde.


Graphikroutinen
---------------
#1 Prog: "Cursor in oder ausserhalb Dreieck?"

Unterthema 2D:
#11 Proc BRESENHAM-Linienalgorithmus
#17 Proc "Bresenham-Circles"
#37 Proc "Circle-Befehl" für ein fenstermittiges Koordinatensystem"
#45 Link: Voxel (Raumelemente): Voxelgrafik / Terrain - XProfan Community
#46 Hinweise: Mit OGL klappts besser
#49 Prog Schnittpunkte Gerade - Ellipse: Prog "Geripse"
#54 Unmenschlich dichter C-Code von Perlin´s Homepage
#80 PROC "EIGEN_DIAGRAMM" (Farbbalken)

#77 "Labyrinthalgo, der niemals richtig funktionierte"
#78 Trick: Mit Fill-Algorithmen Labyrinthrätsel lösen!
#79 Besser per A*-Algo: A*-Algorithmus: Pathfind.dll: Intelligente Wegsuche via externer Dll
#136 Prog "COHEN/SUTHERLAND-LINECLIPPING"
#137 Link: Geometric Tools

Unterthema 3D:
#47 Thema Voxel ( Voxelgrafik / Terrain - XProfan Community ) = Spezialität
#48 Meinung: für Simualtionen vielleicht...
#50 Mittagspausencommanche spielen: Voxelgrafik / Terrain - XProfan Community (Voxel)
#53 Link: Schwimmendes Java-Entchen etc.: Prof. Ken Perlin`s Homepage
#70 Thema "Rund um eine grosse Kugel wandern, z.B. per Maus?"
#72 Thread-Link dazu gefunden: Probleme mit Planeten-Steuerung... - XProfan Community.
#76 Hinweis: 3D-Rotationsmatrix zu Fuß nachgerechnet
#137 Link: Geometric Tools

Video
-----
#97 Link "videoInput Library"
Thema: Gesichtsauffindung und Gesichtserkennung mittels OpenCV: Verfahrensübersicht
Passfotos heute für Gesichtserkennung: Gemäß ISO/IEC 19794-5 zu fotografieren!
#98 Neuronale Netze erkennen Gesichter seitlich und im Halbdunkel

Musik (bzw. Sound)
----------------------
#23 Prog "Piano-Kanal vom Midi spielt Basis des Natürlichen Logarithmus oder Pi"
#212 Link: Hier hat es wer versucht: 64-Bit-Treiber für Beep

Spiele
------
#57 Link: PowderGame; Nachricht: euphoria, Link: Timeline_of_algorithms


Internet
--------
#85 SOCKETPROGRAMMIERUNG
#124 Thema HTML 5

Datenformate
------------
#87 Frage "Ein Wert pro Zeile"-Dateien
#245 Wieviele Byte gehen wirklich auf eine 12cm DVD+R bzw. DVD-R?


Kurioses
--------
#75 Prog "Eierformel"
#25 Fun: MYSTERY PROGRAMMING: LET, WEND. Dann: DOMAIN# und SID#...
#86 Was Wissenschaftler so treiben: Stadtmusikanten aus Atomen
#89 Link BASIC-Interpreter in JAVA
#99 Andere Logik-Formen wie z.B. "Kausalität", "Ironie": Link "Tropes & Idioms"
#110 Geheimnis des Lesens: Es kmmot auf die Vrpunekacg an! Link
#162 Hinweis: Vatertag war in D an Christi Himmelfahrt, in Österreich anderes Datum!
#232 Weisheit: ...oft besser, wenn man nicht alles weiss...
#234 Fun: Pi.z+z.a-Formel

[Frabbing]

Gute Idee!

[p. specht]

Mehr Müll: In einen älteren Mikroprozessor (6502) sollte eine Kubikwurzelfunktion rein (Regelkurve). Aber gehen wir´s schrittweise an:

Quadratwurzel
--------------
Herr Ing. Heron (Gr) sagte nicht nur das mit der Dreiecksflächen-Berechnung, sondern auch, daß man eine Quadratwurzel berechnen kann, in dem man sich Ihr, ausgehend von einem hoffentlich gut gewählten Startwert, durch eine bestimmte Mittelung mit dem jeweils vorher errechneten Wert annähert ("approximiert"):
r! = ( r! + w! / r! )/2 mit w!...Wert-aus-dem-die-Quadratwurzel-zu-ziehen-ist, und einem Startwert für r! (da wir nix Genaues nicht wissen: 1).

Es braucht schon ein paar Durchläufe, bis der Unterschied zum letzten Laufwert kleiner wird als eine geforderte Genauigkeit 0.000001 oder so. (Ursprünglich wollte ich genau wissen wieviele, denn eigentlich sollte der Fehler noch viel kleiner sein, weil wir ja wollen, daß der QUADRIERTE Wert genau unseren Ausgangswert ergeben soll. Eine gewisse Responsezeit durfte dabei nicht überschritten werden).

Bei sehr großen Werten so ab 3e12 (3*10^12) ergeben sich leider immer große Abweichungen - unter anderem, weil die Stellenzahl im Computer bei Float Variablen ja auf 15..16 Stellen begrenzt ist (bei früheren Prozessoren noch deutlich weniger, was die Regelgüte merklich verschlechtert). Manchmal wurde die vorgegebene Genauigkeit überhaupt nie erreicht, weil das Ergebnis der einzelnen Durchläufe abwechselnd oberhalb und unterhalb des Genauigkeits-Zielbandes zu liegen kam. Das Programm mußte dann immer händisch abgebrochen werden. An dieser Stelle eine ernste Warnung: Der Wert 0 und negative Werte in der Klammer sind unbedingt vorher abzufangen!!).

Die Lösung war, die geforderte Genauigkeit an den Eingabewert anzupassen. Das Resultat war dann einigermaßen befriedigend.


Kubikwurzel
-----------
Die nächste Frage war dann: Funktioniert das auch mit einer Kubikwurzel?
Nach einigen Überlegungen: Ja, so ähnlich: r! = ( r! + w! / (r! * r!) ) / 2
Der Knackpunkt war wieder die geforderte Genauigkeit. Geht ganz gut, aber natürlich ohne Gewähr:

WindowTitle "Kubikwurzel iterativ (angelehnt an Heron)"
' Democode, ausschließlich für Lernzwecke. 
' Nicht auf allfällige Schutzreche geprüft.
' Ohne jegliche Garantie. Rechtsweg ausgeschlossen!
set("decimals",19)
cls
declare r!,last_r!,w!,V!,epsi!,i&,sg!,y!,y$
print "Ende durch Eingabe von Null bzw. Return"

                       whilenot %key=27 ' Ewige Schleife

print : print "Eingabewert: ";
input V! : case V!=0 : End
sg!=1: casenot V!=abs(V!) : sg!=-1
v!=abs(v!)
locate %csrlin-1,45 : print "Lg(V)=";int(lg(V!+0.1)+1)
epsi!=1.77*10^(-15 + lg(V!)*(lg(V!)>0)/3 )
r!=1 ' Startwert
i&=0 ' Durchlaufzähler

     ' Hier die Iteration:
      whilenot %key=27
last_r!=r!
r!=(r!+V!/r!/r!)/2
inc i&
      case abs(r!-last_r!)<=epsi! : break
      endwhile
r!=r!*sg!

print "Seitenlaenge a: ";r!;"   nach ";i&;" Durchläufen"
w!=sg!*v!^0.3333333333333333
print "Vergleichswert: ";w!
print "          Diff: ";w!-r!
print
print "  Ergebnisprobe = "; r!*r!*r! ; " Slick: "; r!*r!*r!-sg!*v!
print " Nativwertprobe = "; w!*w!*w! ; " Slack: "; w!*w!*w!-sg!*v!
print "Algorithmen-Diff = "; r!*r!*r! - w!*w!*w!
print
print
                        Endwhile 
                        End

P.S.: Nach dem NEWTON-RAPHSON-Näherungsverfahren x_next=(x - f(x)/f'(x)) ergibt sich folgende Verbesserung für die Iterationsformel der obigen Kubikwurzelfunktion: r! = (2*r!+V!/r!/r!)/3
Ergebnis: Cbrt(1000) wird statt in 48 Durchgängen nun in 15 mit der geforderten Genauigkeit geliefert. Geschwindigkeitsvorteile mit damaligen Prozessoren waren aber wegen Faktor 2 und Division durch 3 statt durch 2 (also blosse Shift-Operation) ohnehin nicht drinnen.

Ein Beispiel für Uralt-Müll. Also immer her mit Eurem eigenen!

[Jac de Lad]

Geil, ich hab noch ne Tonne mathematische Formeln, die werd ich gleich mal raussuchen!

[p. specht]

Dein Zeug ist aber doch nützlich, viel zu schade für hier...
"Experimentalmathematisches" ist natürlich gern gesehen.
Gruss

[AHT]

Ich stells ihn hier auch noch mal hin:
Quelltext eines sehr einfachen RootKit- / Zombieprozessscanners mit geringem Wirkungsgrad und recht abgefahrener Technik (funktioniert für diese Einfachheit schon erstaunlich gut, findet aber natürlich nicht jeden RootKitprozess und nur Zombieprozesse, die ihren Ursprung im Usermode haben) .
Der Quelltext benötigt, um richtig funktionieren zu können, Adminrechte.
Vielleicht hat ja jemand mal Lust, was vernünftiges draus zu basteln...
Für Leute, die mit IE7 und Java6 arbeiten, dürfte es sehr interessant werden, den Quelltext einmal auszuführen.

PS: Ich bin Urheber dieses kleinen Programmes. Ich bitte deshalb darum, den unten stehenden "Zombienator" Quelltext nirgendwo anders zu veröffentlichen oder in eigenen Programmen zu verwenden, ohne mich vorher zu fragen.

'#####################################################################################
'#########                Zombinator XProfan Code von AHT                    #########
'#########                    Für Windows2000/XP/Vista                       #########
'#####################################################################################
 
'#####################################################################
'#########               APIs deklarieren                    #########
'#####################################################################
DEF CheckTokenMembership(3) !"advapi32", "CheckTokenMembership" 'Prüft, ob eine Gruppe einem Token angehört und aktiv ist
DEF ShellExecute(6) !"Shell32", "ShellExecuteA" 'Entspricht ShelExec in Profan, hier können aber Parameter angegeben werden
Def GetModuleFileNameEx(4) !"Psapi","GetModuleFileNameExA" 'Ermittelt den Pfad eines geladenen Moduls
Def CreateToolhelp32Snapshot(2) !"Kernel32", "CreateToolhelp32Snapshot" 'Erzeugt Systemschnappschuss
Def Process32First(2) !"Kernel32", "Process32First" 'Ersten Prozess im Schnappschuss holen
Def Process32Next(2) !"Kernel32", "Process32Next" 'Weitere Prozesse im Schnappschuss holen
Def CloseHandle(1) !"Kernel32", "CloseHandle" 'Kernelhandle schließen
DEF LookupPrivilegeValue(3) !"advapi32","LookupPrivilegeValueA" 'LUID (8-Byte Registrierungszahl) von Privileg erhalten
DEF AdjustTokenPrivileges(6) !"advapi32","AdjustTokenPrivileges" 'Privilegien einstellen
DEF OpenProcessToken(3) !"advapi32","OpenProcessToken" 'Tokenhandle öffnen
DEF CopyMemory(3) !"kernel32","RtlMoveMemory" 'kopiert einen Speicherbereich
DEF GetCurrentProcess(0) !"KERNEL32","GetCurrentProcess" 'Handle auf den aktuellen Prozess holen
DEF ImageList_Create(5) !"COMCTL32","ImageList_Create" 'Imageliste erstellen
DEF ImageList_AddIcon(2) !"COMCTL32","ImageList_AddIcon" 'Icon zur Imageliste hinzufügen
DEF ImageList_Destroy(1) !"COMCTL32","ImageList_Destroy" 'Imageliste löschen
DEF LoadIcon(2) ! "USER32","LoadIconA" 'Icon laden
DEF CreateStatus(4) !"comctl32","CreateStatusWindow" 'Statusbar erzeugen
Def SetWindowPos(7) !"User32","SetWindowPos" 'Fensterposition setzen
Def SetTimer(4) !"USER32","SetTimer" 'Timer setzen
Def KillTimer(2) !"USER32","KillTimer" 'Timer löschen
Def OpenProcess(3) !"Kernel32", "OpenProcess" 'Prozesshandle öffnen
DEF GetDlgCtrlID(1) !"USER32","GetDlgCtrlID" 'ID eines Controls ermitteln
DEF ButtonClicked(1) GetDlgCtrlID(&(1)) = -%MENUITEM 'Wurde Button gedrückt?
DEF DuplicateHandle(7) !"KERNEL32","DuplicateHandle" 'Handle in den eigenen Prozess kopieren
Def NtQueryInformationProcess(5) !"NTDLL","NtQueryInformationProcess" 'Prozess ID ermitteln
Def GetProcessTimes(5) !"KERNEL32","GetProcessTimes" 'Ermittelt unter anderem, wann ein Prozess beendet wurde
Def GetLastError(0) !"KERNEL32","GetLastError" 'Fehlercode auslesen
Def SetLastError(1) !"KERNEL32","SetLastError" 'Fehlercode setzen
'#####################################################################
'#########              Variablen deklarieren                #########
'#####################################################################
Declare SID#, Member&, Counter&, Prog_to_Start$, StartParams$, Fehler&, Operation$, ProgDir$
Declare TOKEN_PRIVILEGES#, LUID#, Iconname#, Hicon&, Imagelist&, Positions#, STATUSBAR&
Declare PROGRESSHandle&, Statustext$, Process_Listview&, neu_scannen&, ButtonFONT&
Declare Spaltentext$, LVC#, Zeile#, Durch%, Hauptfensterbreite&, Hauptfensterhöhe&
Declare TIMER_ID&, LISTVIEW_TEXT#, PROCESSENTRY#, Prozess_Counter&, Itemnumber&
Declare Filename#, ALL_Processes$, NTFehler&, P_Basic#, RetLength&
Declare CreationTime#, ExitTime#, KernelTime#, UserTime#, P_NOW!, P_INC!
'#####################################################################
'#########              Strukturen festlegen                 #########
'#####################################################################
Struct LVCOLUMN = Mask&, FMT&, CX&, Text&, Textlänge&, Subitem&
Struct LVITEM = IMASK&, ITEM&, ISUBITEM&, State&, StateMask&, ITEXT&, ITEXTMAX&, IIMAGE&, ILPARAM&
Struct PROCESSENTRY32=dwSize&,cntUsage&,th32ProcessID&,th32DefaultHeapID&,th32ModuleID&,cntThreads&,th32ParentProcessID&,pcPriClassBase&,dwPrFlags&,szExeFile$(262)
'#####################################################################
'#########               Hauptprogrammteil                   #########
'#####################################################################
'Älter Windowsversionen ausschalten
IF @Val($WINVER)<5
 @messagebox("Auf dieser Windowsversion läuft Zombienator leider nicht, das Programm wird beendet!","Sorry, falsche Windowsversion!",16)
 End
endif
'Bereiche deklarieren
Dim Zeile#, LVITEM
Dim LVC#, LVCOLUMN
Dim PROCESSENTRY#,PROCESSENTRY32
Dim Filename#, 1000
DIM P_Basic#,24
DIM CreationTime#, 8
DIM ExitTime#, 8
DIM KernelTime#, 8
DIM UserTime#, 8
'Überprüft, ob der User ein Administrator ist
DIM SID#, 16
LONG SID#, 0 = 513
LONG SID#, 4 = 83886080
LONG SID#,8 = 32
LONG SID#, 12 = 544
CheckTokenMembership(0, SID#, ADDR(Member&))
Dispose SID#
'Als Admin starten, wenn keine Adminrechte vorliegen
Case Member& = 0 : StartAsAdmin
'Privilegien aktivieren
Set_Privilege_Status "SeDebugPrivilege",$2
'Hauptfenster wird erstellt
Windowstyle 31 + 512
WindowTitle "Zombienator von AHT"
Window 0, 0 - 640, 440
Cls RGB(255,255,100)
Usermessages $10 'Usermessage zum beenden des Programmes
'Imageliste für Listview erstellen
Dim Iconname#,25
Imagelist&=ImageList_Create(16,16,$1 | $8,3,3) 'Imagelist erzeugen
String Iconname#,0="Windows"
Hicon&=loadicon(%HINSTANCE,Iconname#)
ImageList_AddIcon(Imagelist&,HIcon&) 'Index 0 ist "normaler Prozess"
String Iconname#,0="GESICHT"
Hicon&=loadicon(%HINSTANCE,Iconname#)
ImageList_AddIcon(Imagelist&,HIcon&) 'Index 1 ist "RootKit"
String Iconname#,0="MUELL"
Hicon&=loadicon(%HINSTANCE,Iconname#)
ImageList_AddIcon(Imagelist&,HIcon&) 'Index 2 ist "Zombie"
Dispose Iconname#
'Controls erstellen
ButtonFONT& = Create("Font", "Times New Roman", 15, 5, 0, 0, 0) 'Font erstellen
Dim Positions#, 8
Long Positions#, 0=250
Long Positions#, 4=-1
STATUSBAR& =  CreateStatus($50000900 | $4000000, ADDR(Statustext$), %HWND, 2701) 'Statusbar erstellen
Sendmessage(STATUSBAR&,$404,2,Positions#)
Dispose Positions#
LET PROGRESSHandle& = Control("msctls_progress32", "", $10000 + $40000000 + $10000000 + $1000, 3, 4, 250 - 8, Height(Statusbar&) - 7, Statusbar&, 5555, %Hinstance) 'Progressbar erzeugen
LET Process_Listview& = control("SysListView32", "", $40 + $54018001 + $4 + $8 + $800000, 40, 20, ABS( WIDTH(%HWND) - 89), ABS(HEIGHT(%HWND) - 130), %Hwnd, 2698, %Hinstance) 'Prozesslistview erstellen
sendmessage(Process_Listview&, $1036, 0, $20 | $1 | $400)
LET Spaltentext$ = "PID"
LVC#.TEXT& = ADDR(Spaltentext$)
LVC#.MASK& = $0001 + $0002 + $0004 + $0008
LVC#.FMT& = 0
LVC#.CX& = 90
LVC#.Subitem& = 0
LVC#.Textlänge& = LEN(Spaltentext$)
sendmessage(Process_Listview&, $1000+27, 0, LVC#) 'Kopfzeile dem Listview hinzufügen
LET Spaltentext$ = "Status"
LVC#.TEXT& = ADDR(Spaltentext$)
LVC#.Textlänge& = LEN(Spaltentext$)
LVC#.CX& = 70
sendmessage(Process_Listview&, $1000 + 27, 1, LVC#) 'Kopfzeile dem Listview hinzufügen
LET Spaltentext$ = "Dateiname"
LVC#.TEXT& = ADDR(Spaltentext$)
LVC#.Textlänge& = LEN(Spaltentext$)
LVC#.CX& = WIDTH(Process_Listview&) - (70 + 90)
sendmessage(Process_Listview&,$1000+27,2,LVC#) 'Kopfzeile dem Listview hinzufügen
sendmessage(Process_Listview&,$1003,1,Imagelist&) 'Die Imageliste dem Listview zuweisen
neu_scannen&=@Control("Button","",$8000000 + $10000 + $40000000 + $10000000 + $1000 + $2000, 40, ABS(HEIGHT(%HWND)-100), ABS( WIDTH(%HWND) - 89), 30, %HWND, 2119, %HINSTANCE)
SetFont neu_scannen&,ButtonFONT&
Settext neu_scannen&,"neu &scannen"
TIMER_ID&=SetTimer(%HWND,1278,233,ProcAddr("Positioner",4)) 'Timer zum aktualisieren des Fensters
Scan_for_Prozesses
While %Umessage<>$10
 Waitinput
 IF ButtonClicked(neu_scannen&)
  Setmenuitem 0
  Scan_for_Prozesses
 endif
wend
EndProgramm 'Programm beenden
 
'#####################################################################
'#########                   Prozeduren                      #########
'#####################################################################
'Prozedur zum Scannen nach Prozessen, Zombieprozessen und RootKit-Prozessen
Proc Scan_for_Prozesses
 Declare hSnapshot&, Result_HL&, Prozessname$, PHandle&, NetxItem&, Process_PID&
 Declare Handle_not_OK%, HandleWert&, Dup_Handle&, Zombies&, RootKits&, P_NOW!, P_INC!
 EnableWindow neu_scannen&,0
 EnableWindow Process_Listview&,0
 sendmessage(PROGRESSHandle&, $0400 + 2, 0, 0)
 Usecursor 2
 Let Statustext$ = "Prozesse werden gescannt..."
 sendmessage(Statusbar&, $401, 1, addr(Statustext$))
 sendmessage(Statusbar&, $410, 1, addr(Statustext$))
 ALL_Processes$ = ","
 sendmessage(Process_Listview&,$1009,0,0)
 Clear PROCESSENTRY#, Prozess_Counter&, NetxItem&, Zombies&, RootKits&
 Let PROCESSENTRY#.dwSize&=298
 LET hSnapshot& = CreateToolhelp32Snapshot($2, 0) 'Schnappschuss aller sichtbaren Prozesse erstellen
 IfNot hSnapshot& = -1
  LET Result_HL& = Process32First(hSnapshot&, PROCESSENTRY#) 'Ersten Prozess holen
  While and(Result_HL& = 1, %UMESSAGE <> $10)
   Addzeile_To_Listview Process_Listview&, Prozess_Counter&, 0, STR$(PROCESSENTRY#.th32ProcessID&), 0 'PID ins Listview einfügen
   ALL_Processes$ = ALL_Processes$ + STR$(PROCESSENTRY#.th32ProcessID&) + "," 'PID merken, damit man später weiß, welche Prozesse sichtbar waren
   Addzeile_To_Listview Process_Listview&, Prozess_Counter&, 1, "normal", 0 'Ins Listview eintragen, dass es sich um einen normalen Prozess handelt
   PHandle& = OpenProcess($400 | $10, 0, PROCESSENTRY#.th32ProcessID&) 'Prozess öffnen, um Pfad zu holen
   IF PHandle& > 0
    Clear Filename#
    GetModuleFilenameEx(PHandle&, 0, Filename#, 513) 'Wenn sich Prozessdaten auslesen lassen, kompletten Pfad holen
    If len(Trim$(String$(Filename#, 0))) > 3
     Prozessname$ = String$(Filename#, 0)
    Else
     Prozessname$ = PROCESSENTRY#.szExeFile$
    endif
    Closehandle(PHandle&)
   Else
    Prozessname$ = PROCESSENTRY#.szExeFile$ 'Wenn sich Prozessdaten nicht auslesen lassen, Dateinamen verwenden
   endif
   Addzeile_To_Listview Process_Listview&, Prozess_Counter&, 2, Prozessname$, 0 'Pfad oder Dateinamen in Listview eintragen
   LET Result_HL& = Process32Next(hSnapshot&, PROCESSENTRY#)
   LET Prozess_Counter& = Prozess_Counter& + 1 'Zählen, wie viele Prozesse es sind
  EndWhile
  Closehandle(hSnapshot&)
 endif
 P_INC! = 100 / Prozess_Counter&
 EnableWindow Process_Listview&,1
 Let Statustext$ = "Kernelandles werden gescannt..."
 sendmessage(Statusbar&, $401, 1, addr(Statustext$))
 sendmessage(Statusbar&, $410, 1, addr(Statustext$))
 While and(Get_List_Text(Process_Listview&, NetxItem&, 0) <> "", %UMESSAGE <> $10)
  Clear Handle_not_OK%, HandleWert&
  Process_PID& = Val(Get_List_Text(Process_Listview&, NetxItem&, 0)) 'Hole PID eines gefundenen Prozesses aus dem Listview
  SetLastError(0)
  PHandle& = OpenProcess($2000000, 0, Process_PID&) 'Prozess öffnen, um Handles zu kopieren
  Let Fehler&=GetLastError()
  Let Statustext$ = "Kernelhandles werden gescannt (PID " + str$(Process_PID&) + ")..."
  sendmessage(Statusbar&, $401, 1, addr(Statustext$))
  sendmessage(Statusbar&, $410, 1, addr(Statustext$))
  If PHandle& <> 0 'Wenn sich Handles kopieren lassen...
   HandleWert& = 4 'Erster gültiger Handlewert
   While and(Handle_not_OK% < 2500, %UMESSAGE <> $10) 'Solange nach Handles suchen, bis sich 2500 mal hintereinander kein Handle kopieren lässt
    Let Fehler& = DuplicateHandle(PHandle&, HandleWert&, GetCurrentProcess(), addr(Dup_Handle&), $400 | $10, 0, 0) 'Versuche, Handle zu kopieren
    If Fehler& = 0
     Handle_not_OK% = Handle_not_OK% + 1 'Zählen, wie oft sich kein Handle kopieren lässt
    Else 'Wenn sich ein Handle kopieren lässt...
     NTFEHLER& = NtQueryInformationProcess(Dup_Handle&, 0, P_Basic#, 24, addr(RetLength&)) 'PID aus dem Handle ermitteln
     IF NtFehler& = 0 'Wenn sich die PID ermitteln ließ (es sich also um einen Prozess handelt)...
      If instr("," + str$(int(long(P_Basic#,16))) + ",",All_Processes$) = 0 '...und wenn es kein sichtbarer Prozess ist...
       GetProcessTimes(Dup_Handle&, CreationTime#, ExitTime#, KernelTime#, UserTime#) 'Zeit holen, wann der Prozess beendet wurde
       If and(Long(ExitTime#,0) = 0, Long(ExitTime#,4) = 0) 'Wenn er noch läuft, muss der Prozess ein RootKit sein...
        NetxItem& = NetxItem& + 1
        Addzeile_To_Listview Process_Listview&, NetxItem&, 0, str$(int(long(P_Basic#,16))), 1
        Addzeile_To_Listview Process_Listview&, NetxItem&, 1, "RootKit", 0
        Clear Filename#
        GetModuleFilenameEx(Dup_Handle&, 0, Filename#, 513)
        Prozessname$ = String$(Filename#, 0)
        Case len(Prozessname$) > 3 : Addzeile_To_Listview Process_Listview&, NetxItem&, 2, Prozessname$, 0
        RootKits& = RootKits& +1
        Handle_not_OK% = 0
       else '...ansonsten ist es wohl ein Zombieprozess
        NetxItem& = NetxItem& + 1
        Addzeile_To_Listview Process_Listview&, NetxItem&, 0, str$(int(long(P_Basic#,16))), 2
        Addzeile_To_Listview Process_Listview&, NetxItem&, 1, "Zombie", 0
        Clear Filename#
        GetModuleFilenameEx(Dup_Handle&, 0, Filename#, 513)
        Prozessname$ = String$(Filename#, 0)
        Case len(Prozessname$) > 3 : Addzeile_To_Listview Process_Listview&, NetxItem&, 2, Prozessname$, 0 'Nur zur Sicherheit, Zombies haben keinen Pfad mehr, den man auslesen kann
        Zombies& = Zombies& +1
        Handle_not_OK% = 0
       endif
      endif
     endif
     CloseHandle(Dup_Handle&)
    endif
    LET HandleWert& = HandleWert& + 4 'Kleinster zwischen zwei Kernelhandles ist 4, deshalb 4 dazuzählen
   wend
   CloseHandle(PHandle&)
  endif
  NetxItem& = NetxItem& + 1 'Zeigt auf den nächsten sichtbaren Prozess im Listview
  P_NOW! = P_NOW! + P_INC!
  sendmessage(PROGRESSHandle&, $0400 + 2, int(P_NOW!), 0)
 wend
 Let Statustext$ = "RootKits: " + Str$(RootKits&) + " / Zombies: " + Str$(Zombies&) 'Das wars, Ergebnis ausgeben!
 sendmessage(Statusbar&, $401, 1, addr(Statustext$))
 sendmessage(Statusbar&, $410, 1, addr(Statustext$))
 EnableWindow neu_scannen&,1
 EnableWindow Process_Listview&,1
 Usecursor 0
 Beep
endproc
'Ein Programm mit Adminrechten starten
Proc StartAsAdmin
 Clear Counter&, Prog_to_Start$, StartParams$
 Counter& = 1
 Whilenot Counter& > %ParCount
  Let StartParams$ = StartParams$ + CHR$(34) + Par$(Counter&) + CHR$(34) + " "
  LET counter& = Counter& + 1
 wend
 LET StartParams$ = trim$(StartParams$)
 LET Operation$ = "RUNAS"
 LET Progdir$ = Left$($ProgDir, Len($Progdir) - 1)
 Let Prog_to_Start$ = Par$(0)
 LET Fehler& = ShellExecute(%HWND, addr(Operation$), addr(Prog_to_Start$), addr(StartParams$), addr(ProgDir$), 1)
 IF Fehler&>31
  End
 endif
endproc
'Prozedur zum Beenden des Programmes
Proc EndProgramm
 CASE TIMER_ID&<>0 : KiLLTIMER(%HWND,1278)
 CASE neu_scannen&<>0 : Destroywindow(neu_scannen&)
 DELETEOBJECT ButtonFONT&
 Dispose LVC#
 Dispose Zeile#
 Dispose PROCESSENTRY#
 Dispose Filename#
 Dispose P_Basic#
 Dispose CreationTime#
 Dispose ExitTime#
 Dispose KernelTime#
 Dispose UserTime#
 Case Imagelist& <> 0 : ImageList_Destroy(Imagelist&)
 end
endproc
'Prozedur zum aktualisieren der Fenster
Proc Positioner
 IF Durch%=0
  Durch%=1
  IF or(Hauptfensterbreite& <> WIDTH(%HWND), Hauptfensterhöhe& <> HEIGHT(%HWND))
   SetWindowPos Statusbar& = 0, 0 - 0, 0; 0
   Hauptfensterbreite& = WIDTH(%HWND)
   Hauptfensterhöhe& = HEIGHT(%HWND)
   SetWindowPos(Process_Listview&,0, 40, 20, ABS( WIDTH(%HWND) - 89), ABS(HEIGHT(%HWND) - 130), $4)
   SetWindowPos(neu_scannen&, 0, 40, ABS(HEIGHT(%HWND) - 100), ABS( WIDTH(%HWND) - 89), 30, $4)
   Sendmessage(Process_Listview&,$101E,2,WIDTH(Process_Listview&) - (70 + 90))
  endif
  Durch%=0
 endif
endproc
'Prozedur zum Aktivieren von Privilegien
Proc Set_Privilege_Status
 Parameters Privilege_name$, Aktive&
 Declare NewState&, AH_Token_Handle&, LU_SYSTEM$
 DIM TOKEN_PRIVILEGES#, 16
 DIM LUID#, 8
 Clear LUID#, LU_SYSTEM$
 LookupPrivilegeValue(ADDR(LU_SYSTEM$), ADDR(Privilege_name$), LUID#)
 CLEAR AH_Token_Handle&
 LET FEHLER& = OpenProcessToken(GetCurrentProcess(), $20, ADDR(AH_Token_Handle&))
 LONG TOKEN_PRIVILEGES#, 0 = 1
 LET NewState& = TOKEN_PRIVILEGES#
 CopyMemory(NewState& + 4, LUID#, 8)
 LET NewState& = Aktive&
 Clear Aktive&
 IF or(NewState&, $2) = NewState&
  LET Aktive& = or(AKTIVE&, $2)
 Endif
 IF @or(NewState&, $80000000) = NewState&
  LET Aktive& =  or(AKTIVE&, $80000000)
 Endif
 LONG TOKEN_PRIVILEGES#, 12 = Aktive&
 LET FEHLER& =  AdjustTokenPrivileges(AH_Token_Handle&, 0, TOKEN_PRIVILEGES#, 0, 0, 0)
 If AH_TOKEN_Handle& <> 0
  CLOSEHANDLE(AH_Token_Handle&)
 endif
 Dispose TOKEN_PRIVILEGES#
 Dispose LUID#
endproc
'Prozedur zum hinzufügen einer Listviewzeile
Proc Addzeile_To_Listview
 Parameters Lvhndl&, Index&, spalte&, Text$, Image&
 Clear Zeile#
 IF Image&=0
  Zeile#.IMASK&=$0001
 else
  Zeile#.IMASK&=$000B
  Zeile#.IIMAGE&=IMAGE&
 endif
 Zeile#.ITEM&=Index&
 Zeile#.ITEXT&=Addr(Text$)
 Zeile#.ITEXTMAX&=Len(Text$)
 IF spalte&=0
  ItemNumber& = Sendmessage(Lvhndl&, $1007, 0, Zeile#)
 else
  Zeile#.ISUBITEM&=spalte&
  ItemNumber& = Sendmessage(Lvhndl&, $102E, Index&, Zeile#)
 endif
 Return ItemNumber&
Endproc
'Listviewzeile auslesen
Proc Get_List_Text
 Parameters LV_HANDLE&,Priv_List_Index&,spalte&
 Declare ERG$
 DIM LISTVIEW_TEXT#, 1100
 CLEAR Zeile#
 Zeile#.IMASK& = $1
 Zeile#.ITEM& = Priv_List_Index&
 Zeile#.ITEXT& = LISTVIEW_TEXT#
 Zeile#.ITEXTMAX& = 1000
 Zeile#.ISUBITEM& = spalte&
 IF @sendmessage(LV_HANDLE&, $1005, Priv_List_Index&, Zeile#) = 1
  Let ERG$ = String$(LISTVIEW_TEXT#, 0)
 endif
 Dispose LISTVIEW_TEXT#
 Return ERG$
Endproc

[Jac de Lad]

Du kennst mein Zeug doch gar nicht. Algorithmen zum Berechnen ob eine Zahl eine Primzahl ist oder ob zwei Zahlen miteinander befreundet sind sind jetzt nicht so der Brüller.

[AHT]

Zitat von Jac de Lad

...oder ob zwei Zahlen miteinander befreundet sind...

Solange das jugendfrei ist, kann das überall stehen .

[p. specht]

WOW! Immer her damit! Seit dem kürzlich entdeckten Verfahren, mit dem man für 700stellige Zahlen auf einem Durschschnitts-PC innerhalb eines Tages endgültig entscheiden kann, ob sie Prim sind ("Agrawal-Kayal-Saxena AKS-Verfahren"), sind alte Algorithmen dazu tatsächlich Müll...

Das hier ist noch weniger spektakulär und dient ebenfalls keinem weiterführenden Zweck:

WindowTitle "Gleichungswaage"
window %maxX,%maxY
declare x!,y!,x0!,y0!,y1!,y2!,R!,u!,v!,w!,b!,h!,s!,k!,sc!,f%

' Stichwort "Schnittbereiche zwischen höheren Polynomen"
' (Kommt z.B. beim Motormanagement in KFZ vor)
' Prinzip: Wo die rechte Gleichungsseite @l() größer ist als 
' die linke @r(), werden Punkte gezeichnet.
' An den Gebietsrändern ist die Gleichung erfüllt (Lösungen).
' Anm.: Auch reine Berührungslinien (L()=(R)) wären Lösungen, 
' weil die Funktion aber gleich wieder zurückweicht, 
' können sie mit diesem Verfahren nicht dargestellt werden.

' BEISPIEL 1:  c*y^2  =  x^3 + a*x + b
def @l(2) 3*@!(2)*@!(2) ' 2 = parameter y
def @r(2) @!(1)*@!(1)*@!(1) - 260 * @!(1) + 40  ' 1=parameter x

'  BEISPIEL 2
'def @l(2) exp( @!(1) *@!(1) )      
'def @r(2) @!(2)*@!(1)

sc!=10           ' Zentrale Skalierung, definiert den "Abklopfbereich" 
f%=@RGB(255,0,0) ' Punktfarbe


' Zeichne Koordinatenkreuz
b!=width(%hWnd)/2 ' y-Achse in halber Fensterbreite
h!=height(%hWnd)/2' x-Achse in halber Fensterhöhe
UsePen 4,1,0
line 0,h!,2*b!,h!
line b!, 0, b!, 2*h!

x!=-1*b!/sc!      ' Laufvariable auf Untergrenze
y!=-1*h!/sc!

u!=1*b!/sc!         ' Obere Grenze
v!=1*h!/sc!

s!=8 / sc!         ' Step (bei 2: Dichte Flächen)

' Entscheide für jeden einzelnen Punkt der Fensterfläche:
while y!<=v!
  while x!<=u!
  if @l(x!,y!)< @r(x!,y!)
      SetPixel b!+sc!*x!, h!-sc!*y!,f%
      SetPixel b!+sc!*x!+1, h!-sc!*y!,f% 
      SetPixel b!+sc!*x!, h!-sc!*y!+1,f%
      SetPixel b!+sc!*x!+1, h!-sc!*y!+1,f%
  endif
  x!=x!+s!
  endwhile
x!=-1*b!/sc!
y!=y!+s!
endwhile
print "!"
waitinput
End

[AHT]

Kleines "Lernproggie", das versucht unter Vista den eigenen IL zu setzen.
Hab's mir mal geschrieben, um einen bestimmten Sachverhalt darzustellen:

'###########################################################################################
'#########   Testquellcode zum Setzen des IL's des eigenen Prozesses von AHT       #########
'#########                    Für Windows Vista                                    #########
'###########################################################################################
DEF @SetTokenInformation(4) !"advapi32","SetTokenInformation"
DEF @OpenProcessToken(3) !"advapi32","OpenProcessToken" 'Öffnet Einstellprozess.
DEF @LookupAccountName(7) !"advapi32","LookupAccountNameA"
DEF @GetCurrentProcess(0) !"kernel32","GetCurrentProcess" 'Ermittel das Handle des aktiven Prozesses.
DEF @GetLastError(0) !"kernel32","GetLastError"
DEF @SetLastError(1) !"kernel32","SetLastError"
DEF @CopyMemory(3) !"kernel32","RtlMoveMemory"
Declare Fehler&, Token_Handle&,SID#,SIZE_DOMAIN&,SID_SIZE&,F_PROC_Domain#
Declare S_NAME_USE&,SIDA#, Combobox&, Choice$
Proc ChangeIL
 Parameters IL$
 CLS
 Locate 7,0
 Color 12,15
 Print "Versuche IL auf '"+IL$+"' zu setzen..."
 Print ""
 Color 0,15
 SetLastError(0)
 LET FEHLER& = @OpenProcessToken(GetCurrentProcess(),$2000000,@addr(Token_Handle&))
 Print "GetLastError nach OpenProcessToken: "+Str$(GetLastError())
 Print ""
 Print "Rückgabe von OpenProcessToken: "+Str$(Fehler&)
 Print ""
 IF Fehler&<>0
  DIM SID#,1
  DIM F_PROC_Domain#,560
  LET SID_SIZE&=1
  LET SIZE_DOMAIN&=512
  LET Fehler&=@LookupAccountName(0,@addr(IL$),SID#,@ADDR(SID_SIZE&),F_PROC_Domain#,@ADDR(SIZE_DOMAIN&),@ADDR(S_NAME_USE&))
  Dispose SID#
  DIM SID#,int(SID_SIZE&+1)
  LET Fehler&=@LookupAccountName(0,@addr(IL$),SID#,@ADDR(SID_SIZE&),F_PROC_Domain#,@ADDR(SIZE_DOMAIN&),@ADDR(S_NAME_USE&))
  Print "GetLastError nach LookupAccountName: "+Str$(GetLastError())
  Print ""
  Print "Rückgabe von LookupAccountName: "+Str$(Fehler&)
  Print ""
  IF Fehler&=1
   DIM SIDA#,INT(SID_SIZE&+8)
   Long SIDA#,0 = int(SIDA#+8)
   LONG SIDA#,4 = $40 | $20
   Copymemory(int(SIDA#+8),SID#,SID_SIZE&)
   LET fehler&=@SetTokenInformation(Token_Handle&,25,SIDA#,SizeOf(SIDA#))
   Print "GetLastError nach SetTokenInformation: "+Str$(GetLastError())
   Print ""
   Print "Rückgabe von SetTokenInformation: "+Str$(Fehler&)
   Print ""
   Dispose SIDA#
  endif
  Dispose F_PROC_Domain#
  Dispose SID#
 endif
endproc
WindowStyle 31
WindowTitle "Eigenen IL einer Anwendung setzen"
Window 0,0-640,440
Combobox&=@Create("ChoiceBox",%HWND,"",20,20,300,300)
AddChoice(Combobox&,"Niedrige Verbindlichkeitsstufe")
AddChoice(Combobox&,"Hohe Verbindlichkeitsstufe")
AddChoice(Combobox&,"Mittlere Verbindlichkeitsstufe")
AddChoice(Combobox&,"Systemverbindlichkeitsstufe")
While 1
 Waitinput
 If GetText$(Combobox&)<>Choice$
  Choice$=@GetText$(Combobox&)
  ChangeIL Choice$
 endif
wend

[p. specht]

Jawohl, auch schlecht genug für hier. Danke!
Und weil ichs weiter oben schon angedroht hatte:

Windowtitle "BRESENHAM-Algorithmus"
' Nur für Lernzwecke, geproggd von P. Specht
' Mögliche Rechte Dritter wurden nicht geprüft.
Windowstyle 31
Window %maxx*.81,%maxy*.81
Cls @Rgb(221,221,221)

var w%=@width(%hWnd)/2
var h%=@height(%hWnd)/2

brline(0,0, 2*w%,2*h%, @rgb(255,0,0))
brline(0,1, w%-1,2*h%, @rgb(0,255,0))
brline(3,0, 2*w%,h%-3, @rgb(0,0,255))

var i%=0
var j!=0
while i%<360
j!=i%*@pi()/180
brline(w%,h%,w%+240*cos(j!),h%+240*sin(j!),46603*i%)
inc i%,1
endwhile

Print "OK, mit LINE statt Einzelpixel setzen wär´s schneller gegangen..."

WaitInput
End

proc brline
' Bresenham-Algorithmus für Linie in beliebigem Oktanten 
parameters xstart%,ystart%,xend%,yend%,c%
declare i%,el%,pdx%,pdy%,ddx%,ddy%,es%,fehler%
var x% = xstart%
var y% = ystart%
var dx% = xend%-xstart%
var dy% = yend%-ystart%
var adx% = ABS(dx%)
var ady% = ABS(dy%) ' Absolutbetraege
var sdx% = int((dx%>0)-(dx%<0)) ' Signum-Funktion
var sdy% = int((dy%>0)-(dy%<0))

 IF adx% > ady%
   pdx% = sdx%
   pdy% = 0
   ddx% = sdx%
   ddy% = sdy%
   es%  = ady%
   el%  = adx%
 ELSE
   pdx% = 0
   pdy% = sdy%
   ddx% = sdx%
   ddy% = sdy%
   es%  = adx%
   el%  = ady%
 ENDIF
 
 fehler% = el%/2  ' el% gibt auch Anzahl der zu zeichnenden Pixel an 
 
 i%=1
 while i% <= el%
 
    fehler% = fehler% - es%
    IF fehler% < 0
       fehler% = fehler% + el%
       x% = x% + ddx%
       y% = y% + ddy%
    ELSE
       x% = x% + pdx%
       y% = y% + pdy%
    ENDIF

  SETPIXEL x%,y%, x%*y%*3 ' oder c%, wäre Punktfarbe
  inc i%
 endwhile

endproc

Selbst wenn man´s compiliert: Bildschirmschoner wird das keiner mehr...
Aber wie ein Compi Linien zeichnet, zeigt es wenigstens.

[Frabbing]

Klasse!
Solche Routinen sind immer mal für diverse Dinge interessant. Allerdings fände ich es besser, jede Routine separat zu posten, vielleicht am besten in Dlls, Includes, Units & Prozeduren. Das würde die Suche späterer für Andere doch sehr vereinfachen. Was haltet ihr davon?

[p. specht]

Offen gestanden, nix. Wer im Mistkübel graben will, soll sich ruhig reinsteigen trauen.

[Frabbing]

Also so Sachen wie Bresenham-Algo usw. sind sicher kein Mist. Das wird häufiger mal benötigt. Ich selber hab das auch schon schreiben müssen.

[p. specht]

Hastema 'n Euro? Oder ein Altprogramm für unter der Brücke?