Procedure HallofFamelistToTitle(LastInsertId.l=-1) Protected String.s Protected Minutes.l Protected Seconds.l Protected Selected.b Addtitle("Rank"+Chr(9)+" Name"+Chr(9)+"Score"+Chr(9)+"Pieces"+Chr(9)+"Loops"+Chr(9)+"Time",0,128) ForEach Game\HoF() String=Str(ListIndex(Game\HoF())+1) String+Chr(9)+Game\HoF()\Pseudo String+Chr(9)+Game\HoF()\Score String+Chr(9)+StrF(ValF(Game\Hof()\PiecesPerMinute),2)+"/Min" String+Chr(9)+StrF(ValF(Game\Hof()\LoopsPerMinute),2)+"/Min" Minutes=(Val(Game\Hof()\Duration)/1000)/60 Seconds=(Val(Game\Hof()\Duration)/1000)%60 String+Chr(9)+Str(Minutes)+":"+Str(Seconds) If Val(Game\HoF()\Id)=LastInsertId Selected=#True Else Selected=#False EndIf Addtitle(String,0,255,Selected) Next AddTitle("More info on https://loopz.thyphoon.net/",0,255) Titles\Speed=15000 ; Speed EndProcedure ;-################ ;-Local Database UseSQLiteDatabase() #Db=0 Procedure DbError(Sql.s) MessageRequester("Error", "Can't execute the query:"+Chr(13)+Sql+Chr(13)+Chr(13)+DatabaseError()) EndProcedure Procedure CheckDatabaseUpdate(Database, Query$) Protected Result.i Result = DatabaseUpdate(Database, Query$) If Result = 0 DbError(Query$) EndIf ProcedureReturn Result EndProcedure Procedure.s addslashes(txt.s) txt = ReplaceString(txt, "'", "''") ProcedureReturn txt EndProcedure ;Une petite fonction qui manque pour connaitre le dernier ID Procedure DatabaseLastInsertRowId() Protected Sql.s Sql.s = "Select last_insert_rowid()" If DatabaseQuery(#Db, Sql) = 0 DbError(Sql.s) ProcedureReturn 0 Else NextDatabaseRow(#Db) ProcedureReturn GetDatabaseLong(#Db, 0) EndIf EndProcedure Procedure SaveScoreToLocalDB() Protected Sql.s If IsDatabase(#Db) With Game\ScoreData Sql.s = "INSERT INTO [Scores] ('Pseudo','Difficulty','Score','Duration','PiecesPerMinute','LoopsPerMinute','AveragePiecesPerLoop','NbLoop'" sql+",'BigestLoopSize','Bonus_JewelBlue','Bonus_JewelRed','Bonus_JewelGreen','EmptyBench','FPS_Max','FPS_Min','Resolution','Date') VALUES" Sql+" ('" + addslashes(\Pseudo) + "','" + Str(\Difficulty) + "','" + Str(\Score) + "','" + Str(\Duration) + "','"+StrF(\PiecesPerMinute)+"','"+StrF(\LoopsPerMinute)+"','"+StrF(\AveragePiecesPerLoop) Sql+"','"+StrF(\NbLoop)+"','"+StrF(\BigestLoopSize)+"','"+StrF(\Bonus_JewelBlue)+"','"+StrF(\Bonus_JewelRed)+"','"+StrF(\Bonus_JewelGreen)+"','"+StrF(\BenchIsEmpty) Sql+"','"+Str(\Fps_Max)+"','"+Str(\Fps_Min)+"','"+Str(ScreenWidth())+"x"+Str(ScreenHeight()) Sql+"',datetime('now'))" If DatabaseUpdate(#Db, Sql.s); Game\LastInsertIdLocal=DatabaseLastInsertRowId() Debug "LastInsertIdLocal="+Str(Game\LastInsertIdLocal) Else DbError(Sql.s) EndIf Else DisplayWarning("SaveScoreToLocalDB() DB not Ready") EndIf EndWith EndProcedure Procedure LoadHallOfFame(Difficulty.l) If IsDatabase(#Db) If DatabaseQuery(#Db, "SELECT Pseudo,Score,PiecesPerMinute,LoopsPerMinute,Duration,Id FROM Scores WHERE Difficulty="+Str(Difficulty)+" order by Score Desc Limit 0,25") Addtitle("Rank"+Chr(9)+" Name"+Chr(9)+"Score"+Chr(9)+"Pieces"+Chr(9)+"Loops"+Chr(9)+"Time",0,128) Protected Index.l=0 Protected Minutes.l Protected Seconds.l Protected Selected.l While NextDatabaseRow(#Db) ; Loop for each records Index=Index+1 Minutes=(GetDatabaseLong(#Db, 4)/1000)/60 Seconds=(GetDatabaseLong(#Db, 4)/1000)%60 If GetDatabaseLong(#Db,5)=Game\LastInsertIdLocal Selected=#True Else Selected=#False EndIf Addtitle(Str(Index)+Chr(9)+GetDatabaseString(#Db, 0)+Chr(9)+GetDatabaseString(#Db, 1)+Chr(9)+StrF(GetDatabaseFloat(#Db, 2),2)+"/Min"+Chr(9)+StrF(GetDatabaseFloat(#Db, 3),2)+"/Min"+Chr(9)+Str(Minutes)+":"+Str(Seconds),0,255,Selected) Wend FinishDatabaseQuery(#Db) EndIf Else DisplayWarning("LoadHallOfFame() DB not Ready") EndIf EndProcedure ;TODO verifier la version de la base de donnée rajouter une table pour les info ou a voir ;TODO Ajouter la saisie du PlayerKey et chargement des scores Procedure InitDatabase() If FileSize(GetPDataDirectory(""))<>-2 If CreateDirectory(GetPDataDirectory("")) Debug "Create Directory" Else Debug "ERROR Create Directory" EndIf EndIf Protected DBFileName.s = GetPDataDirectory("HighScore.Dat") Debug "InitDatabase() "+DBFileName If FileSize(DBFileName)=-1 Debug "Create DATABASE" If CreateFile(0,DBFileName) CloseFile(0) If OpenDatabase(#Db, DBFileName, "", "", #PB_Database_SQLite) = 0 MessageRequester("Error", "Impossible d'ouvir la base de donnée") End ElseIf DatabaseUpdate(#Db, "BEGIN TRANSACTION"); Protected Sql.s Sql.s="CREATE TABLE [Scores] (" Sql+"[Id] INTEGER NULL PRIMARY KEY AUTOINCREMENT," Sql+"[Pseudo] VARCHAR( 8)," Sql+"[Difficulty] INTEGER NULL," Sql+"[Score] INTEGER NULL," Sql+"[Duration] INTEGER NULL," Sql+"[PiecesPerMinute] INTEGER NULL," Sql+"[LoopsPerMinute] INTEGER NULL," Sql+"[AveragePiecesPerLoop] INTEGER NULL," Sql+"[NbLoop] INTEGER NULL," Sql+"[BigestLoopSize] INTEGER NULL," Sql+"[Bonus_JewelBlue] INTEGER NULL," Sql+"[Bonus_JewelRed] INTEGER NULL," Sql+"[Bonus_JewelGreen] INTEGER NULL," Sql+"[EmptyBench] INTEGER NULL," Sql+"[Date] Text," Sql+"[FPS_Max] INTEGER NULL," Sql+"[FPS_Min] INTEGER NULL," Sql+"[Resolution] Text NULL" Sql+")"; Debug Sql If DatabaseUpdate(#Db,Sql) = 0 DbError(Sql.s) EndIf If DatabaseUpdate(#Db, "COMMIT")=0 DbError(Sql.s) EndIf EndIf EndIf Else If OpenDatabase(#Db, DBFileName, "", "", #PB_Database_SQLite) = 0 MessageRequester("Error", "Impossible d'ouvir la base de donnée") End Else Debug "DATABASE INIT OK" If Not DatabaseUpdate(#Db,"Select Bonus_JewelGreen from Scores") Debug "OLD Database ...i update"; DatabaseUpdate(#Db,"ALTER TABLE [Scores] ADD [AveragePiecesPerLoop] INTEGER NULL") DatabaseUpdate(#Db,"ALTER TABLE [Scores] ADD [Bonus_JewelGreen] INTEGER NULL") EndIf EndIf EndIf EndProcedure ;-################ ;-Server Database Procedure.s TalkToServer(Action.s,Json.s) Protected HttpRequest.i Protected ClientKey.s="KaLkug1265" Protected Send.s Protected Checksum.s Protected StatusCode.s Protected reponse.s NewMap Header$() ;Header$("Content-Type") = "text/plain" Header$("User-Agent") = "Loopz" Send.s="Action="+Action Send+"&Data="+Json Checksum=StringFingerprint(ClientKey+Json, #PB_Cipher_MD5) Send+"&CheckSum="+Checksum Send+"&Version="+#Version CompilerIf #UsePreProdServer=#True Send+"&OnlyToTest=0" CompilerElse Send+"&OnlyToTest=0" CompilerEndIf Debug Send Debug "Server:"+Game\ServerAddress HttpRequest = HTTPRequest(#PB_HTTP_Post, Game\ServerAddress, Send,0,Header$()) If HttpRequest ;Debug HTTPInfo(HTTPRequest, #PB_HTTP_Headers) StatusCode=HTTPInfo(HTTPRequest, #PB_HTTP_StatusCode) Reponse=HTTPInfo(HTTPRequest, #PB_HTTP_Response) Debug "StatusCode: " +StatusCode Debug "Response: " + Reponse Debug "___" FinishHTTP(HTTPRequest) If StatusCode="200" ProcedureReturn Reponse EndIf Else DisplayWarning("Http Request creation failed") EndIf DisplayWarning("Server Error "+Statuscode+Chr(13)+ reponse) ProcedureReturn "" EndProcedure Procedure.s GetAnyValue(Value) Select JSONType(Value) Case #PB_JSON_Null: ProcedureReturn "null" Case #PB_JSON_String: ProcedureReturn GetJSONString(Value) Case #PB_JSON_Number: ProcedureReturn StrD(GetJSONDouble(Value)) Case #PB_JSON_Boolean: ProcedureReturn Str(GetJSONBoolean(Value)) Case #PB_JSON_Array: ProcedureReturn "array" Case #PB_JSON_Object: ProcedureReturn "object" EndSelect EndProcedure Procedure SaveScoreToServerDB() Protected Json.s Protected Reponse.s Game\ScoreData\Resolution=GetCurrentResolution() Game\ScoreData\Os=#CompileVersion Game\ScoreData\GameVersion=#Version Game\ScoreData\ComputerName=ComputerName() Game\ScoreData\UserName=UserName() If CreateJSON(0) InsertJSONStructure(JSONValue(0), @Game\ScoreData, ScoreData) Json=ComposeJSON(0, #PB_JSON_PrettyPrint) FreeJSON(0) EndIf Reponse=TalkToServer("SendScore",Json) Protected NewMap JsonAnswer() If Reponse<>"" If ParseJSON(0, Reponse) If JSONType(JSONValue(0))=#PB_JSON_Object ExtractJSONMap(JSONValue(0),JsonAnswer()) If FindMapElement(JsonAnswer(),"Id") Game\LastInsertIdServer=JsonAnswer("Id") EndIf If FindMapElement(JsonAnswer(),"Rank") Debug " Rank="+JsonAnswer("Rank") EndIf ProcedureReturn #True Else DisplayWarning("ERROR JSON is not Object:"+Chr(13)+Reponse) ProcedureReturn #False EndIf FreeJSON(0) Else Debug "JSon Repond From Server:"+JSONErrorMessage()+Chr(13)+Reponse DisplayWarning("ERROR Can't Parse JSON :"+Chr(13)+Reponse) ProcedureReturn #False EndIf EndIf EndProcedure Procedure LoadHallOfFameFromServer(Difficulty.l) Protected Json.s Protected Reponse.s Protected ObjectValue.i Protected Result.b ClearList(Game\Hof()) If CreateJSON(0) ObjectValue = SetJSONObject(JSONValue(0)) SetJSONInteger(AddJSONMember(ObjectValue, "Difficulty"), Difficulty) SetJSONInteger(AddJSONMember(ObjectValue, "LastInsertId"), Game\LastInsertIdServer) Debug "LastInsertIDServer="+Str(Game\LastInsertIdServer) Json=ComposeJSON(0, #PB_JSON_PrettyPrint) FreeJSON(0) EndIf Reponse=TalkToServer("GetHallOfFame",Json) If reponse<>"" And ParseJSON(0, Reponse) ObjectValue = JSONValue(0) ;Get HoF If GetJSONMember(JSONValue(0), "HoF") And JSONType(GetJSONMember(JSONValue(0), "HoF"))=#PB_JSON_Array ExtractJSONList(GetJSONMember(JSONValue(0) , "HoF"), Game\Hof()) Result=#True EndIf ;Get Error Protected Error.s If GetJSONMember(JSONValue(0), "Error") Error.s=GetJSONString(GetJSONMember(JSONValue(0), "Error")) If Error<>"" DisplayWarning("Server ERROR :"+Error) EndIf EndIf FreeJSON(0) ProcedureReturn Result Else DisplayWarning("ERROR Can't Parse JSON :"+Chr(13)+Reponse) ProcedureReturn #False EndIf EndProcedure ; IDE Options = PureBasic 6.12 beta 4 LTS (Windows - x64) ; CursorPosition = 22 ; Folding = --- ; EnableXP