DroopyLib

[Korolev Michael]

Guys, use PM for conversations on native language.

[GoodNPlenty]

Моя твоя не понимать.

i get from registry this (из реестра получил это значение):
68007400740070003A002F002F003100320037002E0030002E0030002E0031002F00000068007400740070003A002F002F003100320037002E0030002E0030002E0031002F00000000

how to convert this to urls? (как его перевести в буквы, точнее ссылки?)

SeregaZ,
This might be a very crude version of what your looking for. You will have to add code to split the multi strings and handle actual unicode.

Code: Select all

Procedure.s RegistryHex2String(RegistryHexString$)
  Protected Index.i, Current$, RegistryString$
  RegistryString$ = ""
  
  For Index = 1 To Len(RegistryHexString$) Step 4
    Current$ = Chr(Val("$"+Mid(RegistryHexString$, Index, 2)))
    RegistryString$ + Current$
  Next
  
  ProcedureReturn RegistryString$  
EndProcedure

Debug RegistryHex2String("68007400740070003A002F002F003100320037002E0030002E0030002E0031002F00000068007400740070003A002F002F003100320037002E0030002E0030002E0031002F00000000")

Output:

Code: Select all

http://127.0.0.1/http://127.0.0.1/

[User_Russian]

какой командой производить перевод 6800 в букву?

Code: Select all

x=0068
Debug PeekS(@x, -1, #PB_Unicode)

[Droopy]

Hello, i don't want/need REG_MULTI_SZ support to registry functions.
I'm waiting the final PureBasic 5.20 (not the beta), to publish the DroopyLib for PureBasic 5.20
Regards

[SeregaZ]

GoodNPlenty, so it means i need to make some manual table of conversion for correctly reading russian letters? PB have no one automatic converting command?

now this code not use second part of code: 00 for eng, 04 for russian - 43 00 = C, 43 04 = к


Droopy, why that? REG_MULTI_SZ the same part of registry like other types. without support this type library is incomplete.

User_Russian, not working. must be "к", but shows "?"

Code: Select all

x=0443
Debug PeekS(@x, -1, #PB_Unicode)

[GoodNPlenty]

GoodNPlenty, so it means i need to make some manual table of conversion for correctly reading russian letters? PB have no one automatic converting command?

You can use PeekS to convert as shown.

Code: Select all

; Compiler Options
; Create Unicode Executable [X]

If OpenWindow(0, 0, 0, 400, 200, "Russian Cyrillic", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  EditorGadget(0, 5, 5, 390, 190)
    For CharUnicode = $0420 To $043F
      CharUnicodeLine$ + PeekS(@CharUnicode, -1, #PB_Unicode)+" "
    Next
    AddGadgetItem(0, 0, CharUnicodeLine$)
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

Code: Select all

x=0443
Debug PeekS(@x, -1, #PB_Unicode)

not working. must be "к", but shows "?"

Integrated IDE Debugger does not support Unicode.
See above example using EditorGadget

[SeregaZ]

very dirty, and name of function is changed to avoide droopy conflict:

Code: Select all

Procedure RegConvertRegKeyToTopKeyAndKeyNameQ(Key.s) 
  
  Shared topKey,KeyName.s 
  
  temp.s=StringField(Key,1,"\") 
  temp=UCase(temp) 
  Select temp 
    Case "HKEY_CLASSES_ROOT" 
      topKey=#HKEY_CLASSES_ROOT 
    Case "HKEY_CURRENT_USER" 
      topKey=#HKEY_CURRENT_USER 
    Case "HKEY_LOCAL_MACHINE" 
      topKey=#HKEY_LOCAL_MACHINE 
    Case "HKEY_USERS" 
      topKey=#HKEY_USERS 
    Case "HKEY_CURRENT_CONFIG" 
      topKey=#HKEY_CURRENT_CONFIG 
  EndSelect 
  
  PositionSlash=FindString(Key,"\",1) 
  KeyName.s=Right(Key,(Len(Key)-PositionSlash)) 
  
EndProcedure 

ProcedureDLL.s RegGetValueQ(Key.s, ValueName.s, ComputerName.s) ; Gets a Value 
  
  Shared RegWow64.l,RegEx,topKey,KeyName.s 
  RegConvertRegKeyToTopKeyAndKeyNameQ(Key) 
  
  If ComputerName = "." 
    If RegEx 
      GetHandle = RegOpenKeyEx_(topKey,KeyName,0,#KEY_ALL_ACCESS|RegWow64,@hKey) 
    Else 
      GetHandle = RegOpenKey_(topKey,KeyName,@hKey) 
    EndIf 
  Else 
    lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry) 
    If RegEx 
      GetHandle = RegOpenKeyEx_(lhRemoteRegistry,KeyName,0,#KEY_ALL_ACCESS|RegWow64,@hKey) 
    Else 
      GetHandle = RegOpenKey_(lhRemoteRegistry,KeyName,@hKey) 
    EndIf 
  EndIf 
  
  If GetHandle = #ERROR_SUCCESS 
    lpcbData = 255 
    lpData.s = Space(255) 
    
    GetHandle = RegQueryValueEx_(hKey, ValueName, 0, @Type, @lpData, @lpcbData) 
    
    If GetHandle = #ERROR_SUCCESS 
      
      Select Type 
        Case #REG_SZ 
          
          GetHandle = RegQueryValueEx_(hKey, ValueName, 0, @Type, @lpData, @lpcbData) 
          
          If GetHandle = 0 
            GetValue.s = Left(lpData, lpcbData - 1) 
          Else 
            GetValue = "" 
          EndIf 
          
        Case #REG_EXPAND_SZ 
          
          GetHandle = RegQueryValueEx_(hKey, ValueName, 0, @Type, @lpData, @lpcbData) 
          
          If GetHandle = 0 
            GetValue = Left(lpData, lpcbData - 1) 
          Else 
            GetValue = "" 
          EndIf 
          
          
          
        Case #REG_DWORD 
          GetHandle = RegQueryValueEx_(hKey, ValueName, 0, @lpType, @lpDataDWORD, @lpcbData) 
          
          If GetHandle = 0 
            GetValue = Str(lpDataDWORD) 
          Else 
            GetValue = "0" 
          EndIf 
          
        Case #REG_BINARY 
          BinaryBytes=1024 
          *RegBinary=AllocateMemory(BinaryBytes) 
          GetHandle = RegQueryValueEx_(hKey, ValueName, 0, @lType, *RegBinary, @BinaryBytes) 
          If GetHandle = 0 ; SUCCESs 
            GetValue="" 
            For i = 0 To (BinaryBytes-2 ) 
              Temp3=PeekB(*RegBinary+i)&$000000FF 
              If Temp3<16 : GetValue+"0" : EndIf 
              GetValue+ Hex(Temp3) 
            Next 
            FreeMemory(*RegBinary) 
          EndIf 
          
        Case #REG_MULTI_SZ 
          
          tmpsymb$ = "" 
          tmpnum = 1 

          BinaryBytes=1024 
          *RegBinary=AllocateMemory(BinaryBytes) 
          GetHandle = RegQueryValueEx_(hKey, ValueName, 0, @lType, *RegBinary, @BinaryBytes) 
          If GetHandle = 0 ; SUCCESs 
            GetValue="" 
            For i = 0 To (BinaryBytes-2 ) 
              Temp3=PeekB(*RegBinary+i)&$000000FF 
              
              If tmpnum = 1 
                tmpnum = 2 
                If Temp3<16 : tmpsymb$ = "0" : EndIf 
                tmpsymb$ + Hex(Temp3) 
              Else 
                tmpnum = 1 
                If Temp3<16 
                  tmpsymb$ = "$0" + Hex(Temp3) + tmpsymb$ 
                Else 
                  tmpsymb$ = "$" + Hex(Temp3) + tmpsymb$ 
                EndIf 
                
                ;Debug tmpsymb$ 
                
                If tmpsymb$ = "$0000" 
                  GetValue + "   " 
                Else 
                  x=Val(tmpsymb$) 
                  GetValue + PeekS(@x, -1, #PB_Unicode) 
                EndIf 
                
                
                tmpsymb$ = "" 
                
              EndIf              
              
              ;GetValue+ Hex(Temp3) 

            Next 
            FreeMemory(*RegBinary) 
          EndIf 

          
      EndSelect 
    EndIf 
  EndIf 
  RegCloseKey_(hKey) 
  ProcedureReturn GetValue 
EndProcedure 

;Debug RegGetValueQ("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main","NotifyDownloadComplete",".") 

Debug RegGetValueQ("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main","Secondary Start Pages",".") 

[Amor_2001]

Hello, i don't want/need REG_MULTI_SZ support to registry functions.
I'm waiting the final PureBasic 5.20 (not the beta), to publish the DroopyLib for PureBasic 5.20
Regards

Hello Droopy!
The REG_MULTI_SZ key is very important to me.
I need it to create Keys in "Type1 Installer / Type 1 Fonts".
Please consider adding this key in your LIB.

Best Regards

[SeregaZ]

Amor_2001, read part is done. for delete key stardart droopy deleting is fine. so it means we need only text-convert function to this type of value for write.

[Amor_2001]

Amor_2001, read part is done. for delete key stardart droopy deleting is fine. so it means we need only text-convert function to this type of value for write.

If that would go, it would be great. I need a solution as soon as possible anyway.

[Droopy]

Hello, new version avalaible

19/09/13 : Library 5.20.001
Library for PureBasic 5.20 LTS
BargraphGadget example fixed
GraphGadget example fixed

Sorry i don't have time to add registry REG_MULTI_SZ support

[sec]

Have threadsafe/network not mem leak? I will buy!

[Droopy]

Hello, version 5.20.002 available.

TB 1.4.11
NetworkClientEvent4 Removed because now include with PureBasic
GetPidProcess() Moved berfore GetPidProcessEx()
OSVersionText() Added new OS
WNetCancelConnection() Help added
GetUserName() Help added
GetComputerName() help added
Week() bug fixed : Thanks to rule
UpdateWindow() Function added
UpdateResource() Tweaked (don't crash if fail)
Evaluation Tips added
NTP Sample code added
GetTimeZoneName() Function added
GetTimeZone() Function added
Setdate() Function added
LogVersion() Function added
Oem renamed to Console
ConsoleSize Tips added
IsLaptop Tips added
RestoreEx Code added
SelfElevation Tips added

Regards

[Amor_2001]

Hi Droopy,

good job. Unfortunately you do not have time to add the REG_MULTI_SZ key.
It would complete the registry part.

Regards

[NikitaOdnorob98]

I want to offer the revised procedure for removal of a file in the recycle bin. Removes not only the files and folders.

Code: Select all

Procedure DeleteToBin(FileName$,Confirm)
  Protected len, *mem, ok
  len = Len(FileName$)
  *mem = AllocateMemory(len + 2)
  If *mem
    Select FileSize(FileName$)
      Case -2 ;It's folder
        PokeS(*mem,FileName$)
        PokeB(*mem+len+1,0)
        PokeB(*mem+len+2,0)
      Case -1
        FreeMemory(*mem)
        ProcedureReturn #False
      Default ; It's file
        PokeS(*mem,FileName$)
    EndSelect
  Else
    ProcedureReturn #False
  EndIf
  SHFileOp.SHFILEOPSTRUCT
  SHFileOp\pFrom=*mem
  SHFileOp\wFunc=#FO_DELETE
  SHFileOp\fFlags=#FOF_ALLOWUNDO|#FOF_SILENT
  If Confirm = 0
    SHFileOp\fFlags = SHFileOp\fFlags|#FOF_NOCONFIRMATION
  EndIf
  ok = SHFileOperation_(SHFileOp)
  FreeMemory(*mem)
  If ok = 0
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure