WinAPI Library (Snippets) (1163 Beispielcodes)

[RSBasic]

@Vera
So, deine sortierten Listen konnte ich problemlos übernehmen.
Nun sind die Einträge gut sortiert.
Danke
Sieht viel besser aus und ist zudem übersichtlicher.


WinAPI Library 1.2.1 wurde veröffentlicht

Geändert:
• Kategorien und Code-Einträge wurden von Vera sortiert


Online: http://www.rsbasic.de/winapi_library
Offline: Da mein alter Updater auf Dateigröße prüft, können die neuen Dateien nicht so direkt heruntergeladen werden, da sie gleich groß sind.
Am besten die 40 INI-Dateien unter Einstellungen\ löschen und danach Aktualisierung.exe ausführen, dann klappt es auch mit dem Updaten.
Oder halt komplett: http://www.rsbasic.de/downloads/winapi_library.zip

[neotoma]

Richedit Set/Unset Text-Backcolor.
Wie man die Hintergrundfarbe setzt, ist oft zu finden. Wie man sie wieder löscht, ist
seltener....

Code: Alles auswählen

EnableExplicit

CompilerIf Defined(CFM_BACKCOLOR, #PB_Constant)
CompilerElse
  #CFM_BACKCOLOR =$4000000
CompilerEndIf

CompilerIf Defined(CFE_AUTOBACKCOLOR, #PB_Constant)
CompilerElse
  #CFE_AUTOBACKCOLOR =#CFM_BACKCOLOR
CompilerEndIf


Declare.l Editor_SetBackColor(Gadget, Color)
Declare.l Editor_UnsetBackColor(Gadget)

Define a, EventID


If OpenWindow(0,0,0,500,250,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  EditorGadget(1,10,10,480,200,0)
  ButtonGadget(2,10,220,100,20,"Set Backcolor")
  ButtonGadget(3,390,220,100,20,"Unset Backcolor")
  
  For a=1 To 10
    AddGadgetItem(1,-1,"Teststring",0,0)
  Next
  
  Repeat
  EventID=WaitWindowEvent()
  If EventID=#PB_Event_Gadget
    Select EventGadget()
      Case 2
        SendMessage_(GadgetID(1),#EM_SETSEL,0,-1)   ; Select all      
        Editor_SetBackColor(1, #Yellow)
        SendMessage_(GadgetID(1),#EM_SETSEL,0,0)    ;Deselect all
      Case 3
        SendMessage_(GadgetID(1),#EM_SETSEL,0,-1)   ; Select all      
        Editor_UnsetBackColor(1)
        SendMessage_(GadgetID(1),#EM_SETSEL,0,0)    ;Deselect all      
    EndSelect
  EndIf
  Until EventID=#PB_Event_CloseWindow
EndIf

Procedure.l Editor_SetBackColor(Gadget, Color)
  Protected format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)
  format\dwMask = #CFM_BACKCOLOR
  format\crBackColor = Color
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure.l Editor_UnsetBackColor(Gadget)
  Protected format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)
  format\dwMask = #CFM_BACKCOLOR
  format\dwEffects = #CFE_AUTOBACKCOLOR
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

[neotoma]

Richedit - GetFirstVisibleLine

Code: Alles auswählen

; Author: Michael 'neotoma' Taupitz

EnableExplicit

Declare.s GetTestText()
Declare.l Editor_GetFirstVisibleLineNumber(Gadget)
Declare.s Editor_GetFirstVisibleLineText(Gadget)

If OpenWindow(0,0,0,500,250,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  EditorGadget(1,10,10,480,210,0)
  If CreateStatusBar(0, WindowID(0))
      AddStatusBarField(80)
      AddStatusBarField(410)
  EndIf
  SetGadgetText(1,GetTestText())
  SendMessage_(GadgetID(1),#EM_SETSEL,2,5)
    
  Repeat
    StatusBarText(0, 0, "Topline Nr.:"+Str( Editor_GetFirstVisibleLineNumber(1)) )
    StatusBarText(0, 1, Editor_GetFirstVisibleLineText(1))  
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

Procedure.l Editor_GetFirstVisibleLineNumber(Gadget)
  Protected result=SendMessage_(GadgetID(Gadget),#EM_GETFIRSTVISIBLELINE,0 ,0)
  ProcedureReturn result
EndProcedure 

Procedure.s Editor_GetFirstVisibleLineText(Gadget)
  Protected iTopLine.i, iLineLength.i, iCharPos.i, Result.s
  iTopLine=SendMessage_(GadgetID(Gadget), #EM_GETFIRSTVISIBLELINE, 0 ,0)
  iCharPos=SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, iTopLine ,0)
  iLineLength=SendMessage_(GadgetID(Gadget), #EM_LINELENGTH ,iCharPos ,0)
  Result = Space(iLineLength)
  SendMessage_(GadgetID(Gadget), #EM_GETLINE, iTopLine ,@Result)
  ProcedureReturn Result
EndProcedure 

Procedure.s GetTestText()
  Protected i.i
  Protected TestText.s = "{\rtf1\ansi\ansicpg1252\deff0\deflang1031{\fonttbl{\f0\fnil\fcharset0 Tahoma;}{\f1\fnil\fcharset0 MS Shell Dlg;}{\f2\fnil\fcharset2 Symbol;}}"
  TestText + "{\colortbl ;\red255\green170\blue85;\red0\green85\blue255;}"
  TestText + "\viewkind4\uc1\pard\qj\f0\fs32 "
  For i = 0 To 400
    TestText + Str(i) + "{\tab}$" + RSet(Hex(i), 4, "0") + "{\tab}" + Str(Random(1000)) + "\par"+#CRLF$
  Next      
  TestText + "}"
  Debug("Testtext finished")
  ProcedureReturn TestText
EndProcedure
 

[neotoma]

Das Redraw des EditorGadgets unterdrücken, während man
den Text mit dem Programm bearbeitet. Das spart Zeit und sieht besser aus.

Code: Alles auswählen

; Author: Michael 'neotoma' Taupitz

EnableExplicit

;Declares
Declare.s GetTestText()
Declare.l FlickerWork(Gadget)
Declare.l Editor_DisableRedraw(Gadget, bVal.i=#True)

Define Event.i

If OpenWindow(0,0,0,500,250,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  EditorGadget(1,10,10,480,210,0)
  SetGadgetText(1,GetTestText())
  
  ButtonGadget(100 , 10,225,100,20,"Flicker")
  ButtonGadget(150 , 390,225,100,20,"Non Flicker")
    
  Repeat
    Event = WaitWindowEvent()
    If Event = #PB_Event_Gadget
      Select EventGadget()
        Case 100  ; Flicker
          SendMessage_(GadgetID(1), #EM_SETSEL, -1, 0)          
          FlickerWork(1)
        Case 150  ; NonFlicker
          SendMessage_(GadgetID(1), #EM_SETSEL, -1, 0)          
          Editor_DisableRedraw(1)        ;Disable Redraw
          FlickerWork(1)
          Editor_DisableRedraw(1,#False) ;Enable Redraw
          
          ;This to mak a Redrwa after Finishing - to see the Changes.
          RedrawWindow_(GadgetID(1),0,0,#RDW_UPDATENOW|#RDW_ERASE|#RDW_INVALIDATE)          
      EndSelect
    EndIf 
  Until Event = #PB_Event_CloseWindow
EndIf

;==============================================================================
; Procedure Name ....:  Editor_DisableRedraw
; Description .......:  When performing several actions, or actions on text that
;                       is not currently in the visible window, or when changing
;                       selections repeatedly - an EditorGadget may flicker.
;                       Disabling the Gadget with WM_SetReDraw before taking
;                       actions, then turning enabling it after the actions have
;                       been taken can significantly improve performance.. 
;
; Syntax ............:  Editor_DisableRedraw(Gadget, bVal.i=#True)
; Parameter(s) ......:  Gadget    - A PB-GadgetId
;                       bVal      - #True (default) to Disable Redraw
;                                 - #False to Enable / reenable Redraw
; Return value(s) ...:  Nothing
;
; Author(s) .........:   Michael 'neotoma' Taupitz
; Creation Date .....:   18.06.2010
; Version ...........:   0.0.0.1
; Last Update .......:   
; Remarks ...........:   
;==============================================================================

Procedure.l Editor_DisableRedraw(Gadget, bVal.i=#True)
  SendMessage_(GadgetID(Gadget),#WM_SETREDRAW,1!bVal ,0)  
EndProcedure 

;Testprocedure to make some Operations on the EditorGadget
Procedure.l FlickerWork(Gadget)
  Protected i.i,m.i,n.i,iResult.i
  For i = 1 To 1000
    m = Random(240)
    n = m + Random(240-m)
    iResult = SendMessage_(GadgetID(Gadget), #EM_SETSEL, m, n+1)
  Next i  
  iResult = SendMessage_(GadgetID(Gadget), #EM_SETSEL, 0,2)    
EndProcedure  

;Create a Test-Text
Procedure.s GetTestText()    
  Protected i
  Protected TestText.s = "{\rtf1\ansi\ansicpg1252\deff0\deflang1031{\fonttbl{\f0\fnil\fcharset0 Tahoma;}{\f1\fnil\fcharset0 MS Shell Dlg;}{\f2\fnil\fcharset2 Symbol;}}"
  TestText + "{\colortbl ;\red255\green170\blue85;\red0\green85\blue255;}"
  TestText + "\viewkind4\uc1\pard\qj\f0\fs32 "
  For i = 0 To 120
    TestText + Str(i) + "{\tab}$" + RSet(Hex(i), 4, "0") + "{\tab}" + Str(Random(1000)) + "\par"+#CRLF$
  Next  
  TestText + "}"
  ProcedureReturn TestText
EndProcedure

[neotoma]

Den Speicherverbrauch eines Prozesses ermitlen (auch des eigenen) und unbenutzten Speicher freigebn.

Code: Alles auswählen

; Author: Michael 'neotoma' Taupitz
; Minimum-System : Windows 2000 Prof.

EnableExplicit

CompilerIf Defined(PROCESS_MEMORY_COUNTERS , #PB_Structure)
CompilerElse
Structure PROCESS_MEMORY_COUNTERS
  cb.l                              ;The size of the structure, in bytes.
  PageFaultCount.l                  ;The number of page faults.
  PeakWorkingSetSize.i              ;The peak working set size, in bytes.
  WorkingSetSize.i                  ;The current working set size, in bytes.
  QuotaPeakPagedPoolUsage.i         ;The peak paged pool usage, in bytes.
  QuotaPagedPoolUsage.i             ;The current paged pool usage, in bytes.
  QuotaPeakNonPagedPoolUsage.i      ;The peak nonpaged pool usage, in bytes.
  QuotaNonPagedPoolUsage.i          ;The current nonpaged pool usage, in bytes.
  PagefileUsage.i                   ;The current space allocated for the pagefile, in bytes.
                                    ; (Those pages may or may not be in memory.)
  PeakPagefileUsage.i               ;The peak space allocated for the pagefile, in bytes.
EndStructure 
CompilerEndIf

; Prototypes 
Prototype.i EmptyWorkingSet( hProcess.i)
Prototype.i GetProcessMemoryInfo( hProcess.i, *ppsmemCounters.PROCESS_MEMORY_COUNTERS, cb.i)



;Declares 
Declare.i BoostMemory(PID)
Declare.i GetProcessMemoryUsage(pid)
Declare.i GetCurrentMemoryUsage()
Declare.i BoostCurrentMemory()

; Mainloop for Test/Demo
Define Event.i


If OpenWindow(0,0,0,200,60,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  TextGadget(1,30,10,180,20,"",0)  
  ButtonGadget(2,50,30,100,20,"Boost")  
  Repeat
    Event = WaitWindowEvent()
    Select Event    
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 2 : BoostCurrentMemory()
        EndSelect
    EndSelect
        
    SetGadgetText(1,"Memory-Usage: "+StrF( GetCurrentMemoryUsage()/1024.0,1 )+" Kb")
    
  Until Event = #PB_Event_CloseWindow
EndIf

End


; Uses the PsAPI-Function EmptyWorkingSet()
Procedure.i BoostMemory(PID)
  Protected Result.i
  Protected EmptyWorkingSet.EmptyWorkingSet
  Protected  lib_psapi = OpenLibrary (#PB_Any, "psapi.dll")
  If lib_psapi
    EmptyWorkingSet.EmptyWorkingSet = GetFunction(lib_psapi,"EmptyWorkingSet")
    Result = EmptyWorkingSet( PID )
    CloseLibrary(lib_psapi)    
  EndIf
  ProcedureReturn Result
EndProcedure 


; Uses the PsAPI-Function GetProcessMemoryInfo()
Procedure.i GetProcessMemoryUsage(pid)
  Protected Result.i
  Protected PMC.PROCESS_MEMORY_COUNTERS
  Protected GetProcessMemoryInfo.GetProcessMemoryInfo

  Protected  lib_psapi = OpenLibrary (#PB_Any, "psapi.dll")
  If lib_psapi
    GetProcessMemoryInfo.GetProcessMemoryInfo = GetFunction(lib_psapi,"GetProcessMemoryInfo")
    If GetProcessMemoryInfo( GetCurrentProcess_(), @PMC, SizeOf(PROCESS_MEMORY_COUNTERS))
      Result = PMC\WorkingSetSize    
    EndIf
    CloseLibrary(lib_psapi)    
  EndIf
    
  ProcedureReturn Result;
EndProcedure  

;Get for the current process
Procedure.i GetCurrentMemoryUsage()
  ProcedureReturn GetProcessMemoryUsage(GetCurrentProcess_())
EndProcedure

;Boost for the current process
Procedure.i BoostCurrentMemory()
  ProcedureReturn BoostMemory(GetCurrentProcess_())
EndProcedure 

[neotoma]

Die Treiber ermitteln..

Code: Alles auswählen

; Author: Michael 'neotoma' Taupitz
; Minimum-System : Windows 2000 Prof.

EnableExplicit

#MAX_DRIVERS = 1024


Prototype.i EnumDeviceDrivers( lpImageBase.i, cb.i, lpcbNeeded.i)
Prototype.i GetDeviceDriverBaseName( ImageBase.i, lpBaseName.i,nSize.i)
Prototype.i GetDeviceDriverFileName( ImageBase.i, lpFileName.i,nSize.i)


Define EnumDeviceDrivers.EnumDeviceDrivers
Define GetDeviceDriverBaseName.GetDeviceDriverBaseName
Define GetDeviceDriverFileName.GetDeviceDriverFileName

Define lib_psapi
Define szDriver.s{1024}
Define szDriverFile.s{1024}
Define cbNeeded.l
Define cDrivers.l, i;
Dim drivers.l(#MAX_DRIVERS)


lib_psapi = OpenLibrary (#PB_Any, "psapi.dll")
If lib_psapi
  If OpenWindow(0,0,0,500,250,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    ListIconGadget(1,10,10,480,230,"Driver",200,0)
    AddGadgetColumn(1,1,"File",300)
    
    EnumDeviceDrivers.EnumDeviceDrivers = GetFunction(lib_psapi,"EnumDeviceDrivers")
    CompilerIf #PB_Compiler_Unicode    
      GetDeviceDriverBaseName.GetDeviceDriverBaseName = GetFunction(lib_psapi,"GetDeviceDriverBaseNameW")  
      GetDeviceDriverFileName.GetDeviceDriverFileName = GetFunction(lib_psapi,"GetDeviceDriverFileNameW")
    CompilerElse
      GetDeviceDriverBaseName.GetDeviceDriverBaseName = GetFunction(lib_psapi,"GetDeviceDriverBaseNameA")  
      GetDeviceDriverFileName.GetDeviceDriverFileName = GetFunction(lib_psapi,"GetDeviceDriverFileNameA")
    CompilerEndIf
    
    If EnumDeviceDrivers(@drivers(), #MAX_DRIVERS*SizeOf(Long), @cbNeeded ) And cbNeeded < #MAX_DRIVERS*SizeOf(Long)
      cDrivers = cbNeeded/SizeOf(Long);
      MessageRequester("Info","Total Device Drivers count : "+Str(cDrivers));
      
      For i = 0 To cDrivers-1
        GetDeviceDriverBaseName( drivers(i), @szDriver    , 1024/SizeOf(CHARACTER) );
        GetDeviceDriverFileName( drivers(i), @szDriverFile, 1024/SizeOf(CHARACTER) );
        AddGadgetItem(1,-1,szDriver+Chr(10)+szDriverFile,0,0)        
      Next
    EndIf
    
    Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
    
  EndIf      
EndIf  
  

[neotoma]

Ich weiß nicht, ob es richtig in die WinAPI passt.

DosBox in einem Verzeichnis öffnen.

Code: Alles auswählen

Define Event.i
Define Path.s ="C:\"

If OpenWindow(0,0,0,350,60,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  TextGadget  (1, 30,12, 80,20,"Open Dos at:",0)  
  StringGadget(2,115,10,120,20,Path)  
  ButtonGadget(3,240,10,40,20,"...")  
  ButtonGadget(4, 30,35,100,20,"Open DOS")  
  Repeat
    Event = WaitWindowEvent()
    Select Event    
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 3 : 
            Path = PathRequester("Bitte wählen Sie einen Pfad aus", Path)
            SetGadgetText(2,Path)
          Case 4 :    
            Select OSVersion() 
              Case #PB_OS_Windows_95,#PB_OS_Windows_98,#PB_OS_Windows_ME
                RunProgram("command", "/K chdir /D "+Path,"")       ;WinNT, 2000, XP, Vista
              Default
                RunProgram("cmd", "/K chdir /D "+Path,"")       ;WinNT, 2000, XP, Vista
             EndSelect
        EndSelect
    EndSelect
        
    
  Until Event = #PB_Event_CloseWindow
EndIf

End

[ts-soft]

Den Speicherverbrauch eines Prozesses ermitlen (auch des eigenen) und unbenutzten Speicher freigebn.

Korrekte Strukture:

Code: Alles auswählen

Structure PROCESS_MEMORY_COUNTERS
  cb.l                              ;The size of the structure, in bytes.
  PageFaultCount.l                  ;The number of page faults.
  PeakWorkingSetSize.i              ;The peak working set size, in bytes.
  WorkingSetSize.i                  ;The current working set size, in bytes.
  QuotaPeakPagedPoolUsage.i         ;The peak paged pool usage, in bytes.
  QuotaPagedPoolUsage.i             ;The current paged pool usage, in bytes.
  QuotaPeakNonPagedPoolUsage.i      ;The peak nonpaged pool usage, in bytes.
  QuotaNonPagedPoolUsage.i          ;The current nonpaged pool usage, in bytes.
  PagefileUsage.i                   ;The current space allocated for the pagefile, in bytes.
                                    ; (Those pages may or may not be in memory.)
  PeakPagefileUsage.i               ;The peak space allocated for the pagefile, in bytes.
EndStructure 

Dann klappt es auch mit dem x64 Nachbarn

Gruß
Thomas

[neotoma]

Dann klappt es auch mit dem x64 Nachbarn

Danke dir. Habe es oben bereits verbessert.

Gruß,
Mike

[Marvin]

Den Speicherverbrauch eines Prozesses ermitteln (auch des eigenen) und unbenutzten Speicher freigeben.

Gibt das wirklich den Speicher frei? Soweit ich das sehe, werden nur alle in die Auslagerungsdatei auslagerbaren Pages dorthin aus dem physischen Speicher verschoben…