PureBasic Forums - English

Code: Select all

ProcedureDLL Count(a,b)
 For x=a To b
 resultado=x
 Next
ProcedureReturn resultado
EndProcedure 

ProcedureDLL PatchFile(file.s,location.l,byte.s,aplicado.s,erro.s) 
CopyFile(file,file+".bak")
  If OpenFile(0,file) 
    FileSeek(location) 
    WriteString(byte) 
    CloseFile(0)
    MessageRequester("Sucesso!",aplicado) 
    ProcedureReturn 1
  Else
  MessageRequester("Erro!",erro)
  ProcedureReturn 1
  EndIf
EndProcedure 
;Fast Patch
ProcedureDLL FastPatchFile(file.s,location.l,byte.s) 
CopyFile(file,file+".bak")
  If OpenFile(0,file) 
    FileSeek(location) 
    WriteString(byte) 
    CloseFile(0)
    ProcedureReturn 1
  EndIf  
EndProcedure

;Graus F to C
ProcedureDLL FtoC(garuf.s)
gF$=garuf
calk1=Val(gF$)-32
calkA=calk1*5
calk2=calkA/Val("9")
ProcedureReturn calk2
EndProcedure

;print colorido
ProcedureDLL PrintC(string.s,charcolor,bkcolor)
ConsoleColor(charcolor,bkcolor)
Print(string)
EndProcedure

ProcedureDLL PrintNC(string.s,charcolor,bkcolor)
ConsoleColor(charcolor,bkcolor)
PrintN(string)
EndProcedure

ProcedureDLL Console()
OpenConsole()
EndProcedure

;Abrir Arquivo de Texto
ProcedureDLL OpenTextFile(gadget)
    Pattern$ = "Text (*.txt)|*.txt;*.bat|All files (*.*)|*.*"
    Pattern = 0
    opentextmail$ = OpenFileRequester("Abrir Texto",StandardFile$,Pattern$, Pattern)
    d=ReadFile(1,opentextmail$)
    If d
      While Eof(1)=0 
        Text$ = text$+ReadString()+Chr(13)+ Chr(10) 
      Wend 
      CloseFile(1)
      SetGadgetText(gadget,"") 
      SetGadgetText(gadget, Text$) 
      Else
      ;MessageRequester("Error","No valid file was selected.",#MB_ICONERROR) 
      EndIf 
EndProcedure

ProcedureDLL OpenTextFileHx(gadget)
Pattern$ = "Text (*.txt)|*.txt;*.bat|All files (*.*)|*.*"
Pattern = 0
    opentextmail$ = OpenFileRequester("Abrir Texto",StandardFile$,Pattern$, Pattern)
    d=ReadFile(1,opentextmail$)
    If d
      While Eof(1)=0 
        Text$ = text$+ReadString() 
      Wend 
      CloseFile(1) 
      SetGadgetText(gadget, Text$) 
      Else
      ;MessageRequester("Error","No valid file was selected.",#MB_ICONERROR) 
      EndIf 
EndProcedure

ProcedureDLL SaveTextFile(gadget)
Pattern$ = "Text (*.txt)|*.txt;*.bat|All files (*.*)|*.*"
Pattern = 0
    createfile$ = SaveFileRequester("Salvar Texto",StandardFile$,Pattern$, Pattern)
    CreateFile(1,createfile$)
    WriteString(GetGadgetText(gadget))
    CloseFile(1)
EndProcedure


;Capture Screen


;Zenite Polar
ProcedureDLL.s ZenitPolar(mystring.s) 
mystring2.s="" 
lenght=Len(mystring) 
For n=1 To lenght 
ascii=Asc(Mid(mystring,n,1)) 
Select ascii 
Case 90:ascii=80;  "Z" to "P" 
Case 69:ascii=79;  "E" to "O" 
Case 78:ascii=76;  "N" to "L" 
Case 73:ascii=65;  "I" to "A" 
Case 84:ascii=82;  "T" to "R" 
Case 122:ascii=112;  "z" to "p" 
Case 101:ascii=111;  "e" to "o" 
Case 110:ascii=108;  "n" to "l" 
Case 105:ascii=97;  "i" to "a" 
Case 116:ascii=114;  "t" to "r" 
Case 80:ascii=90;  "P" to "Z" 
Case 79:ascii=69;  "O" to "E" 
Case 76:ascii=78;  "L" to "N" 
Case 65:ascii=73;  "A" to "I" 
Case 82:ascii=84;  "R" to "T" 
Case 112:ascii=122;  "p" to "z" 
Case 111:ascii=101;  "o" to "e" 
Case 108:ascii=110;  "l" to "n" 
Case 97:ascii=105;  "a" to "i" 
Case 114:ascii=116;  "r" to "t"
EndSelect 
mystring2=mystring2+Chr(ascii) 
Next n 
ProcedureReturn mystring2 
EndProcedure 


ProcedureDLL.s GetMyIP()
Html.s  = Space(84) 

hInet.l = InternetOpen_("http://gansta93.free.fr", 1, #Null, #Null, 0) 
If hInet 
  hURL.l  = InternetOpenUrl_(hInet, "http://gansta93.free.fr/IP.php", #Null, 0, #Null, 0) 
  If hURL 
    If InternetReadFile_(hURL, @Html, Len(Html), "84") 
      Html = Trim(Html)     
EndIf
EndIf 
EndIf
ProcedureReturn Html
EndProcedure