Auction House System

Option 1, Download the client & server with this feature added.

http://www.mmorpgcre…tionHouseEO.rar

Option 2, Add the tutorial into your existing project.

First off download this attachment set and add it to the server and client.

http://www.mmorpgcre…/Attachment.rar

Now we will start with the client.

Add frmAuction and modAuction to your project if you have no already.

Now in modHandleData add:


HandleDataSub(SAuct) = GetAddress(AddressOf HandleRecieveAAucts)

And at the bottom add:


Private Sub HandleRecieveAAucts(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

Dim Buffer As clsBuffer

Dim num As Long

Dim i As Long

Set Buffer = New clsBuffer

		 With Buffer

				 .WriteBytes Data

		 For i = 1 To 100

				 Auction(i).Owner = .ReadString

				 Auction(i).Item = .ReadLong

				 Auction(i).Price = .ReadLong

				 Auction(i).MaxBid = .ReadLong

				 Auction(i).EndDate = .ReadLong

				 Auction(i).Amount = .ReadLong

				 Auction(i).Bid = .ReadLong

		 Next i

		 End With

		 Set Buffer = Nothing

With frmAuctions

						 .lstAuctions.Clear

		 For i = 1 To 100

				 If Auction(i).Owner <> vbNullString Then

						 .lstAuctions.AddItem Item(Auction(i).Item).Name & " Price: " & Auction(i).Price

				 Else

						 .lstAuctions.AddItem "Empty"

				 End If

		 Next i

End With

End Sub

Next in modGraphics in Public Sub DrawGDI() add:


If frmAuctions.fraNew.Visible Then

		 If CurrentAuctionselections <> 0 Then

			 DrawAuctionItemDesc CurrentAuctionselections

		 End If

	 End If

And at the bottom of modGraphics add:


Public Sub DrawAuctionItemDesc(ByVal ItemNum As Long)

Dim rec As RECT, rec_pos As RECT, srcRect As D3DRECT, destRect As D3DRECT

Dim itempic As Long

' If debug mode, handle error then exit out

If Options.Debug = 1 Then On Error GoTo errorhandler

'frmMain.picItemDescPic.Cls

If ItemNum > 0 And ItemNum <= MAX_ITEMS Then

		 itempic = Item(GetPlayerInvItemNum(MyIndex, ItemNum)).Pic

		 If itempic = 0 Then Exit Sub

		 Direct3D_Device.Clear 0, ByVal 0, D3DCLEAR_TARGET, D3DColorRGBA(0, 0, 0, 0), 1#, 0

		 Direct3D_Device.BeginScene

		 With rec

				 .Top = 0

				 .Bottom = .Top + PIC_Y

				 .Left = Tex_Item(itempic).Width / 2

				 .Right = .Left + PIC_X

		 End With

		 With rec_pos

				 .Top = 0

				 .Bottom = 64

				 .Left = 0

				 .Right = 64

		 End With

		 RenderTextureByRects Tex_Item(itempic), rec, rec_pos

		 With destRect

				 .X1 = 0

				 .Y1 = 0

				 .y2 = 64

				 .x2 = 64

		 End With

		 Direct3D_Device.EndScene

		 Direct3D_Device.Present destRect, destRect, frmAuctions.picItem.hWnd, ByVal (0)

End If

' Error handler

Exit Sub

errorhandler:

HandleError "DrawAuctionItemDesc", "modGraphics", Err.Number, Err.Description, Err.Source, Err.HelpContext

Err.Clear

Exit Sub

End Sub

Next will involve adding a button or label of some sort, and adding this to the click handler:


frmAuctions.Visible = True

frmAuctions.fraMain.Visible = True

frmAuctions.fraNew.Visible = False

frmAuctions.fraBuy.Visible = False

Call SendGetAuctions

Now in Private Sub picInventory_DblClick() Add:


If IsPickingItem = True Then

			 CurrentAuctionselections = InvNum

			 IsPickingItem = False

			 Exit Sub

		 End If

Above:


' use item if not doing anything else

	 If Item(GetPlayerInvItemNum(MyIndex, InvNum)).Type = ITEM_TYPE_NONE Then Exit Sub

	 Call SendUseItem(InvNum)

	 Exit Sub

End If

And finally with the server packets add:


SAuct

and with the client packets add:


CAddAuct

CCheckAuct

CBid

Now lets move on to the server.

Add the appropriate files included with the attachments into your server’s source.

in modDatabase add:


Public Sub SaveAuctions(ByVal AuctionNum As Long)

Dim Filename As String

Dim F As Long

Filename = App.path & "\data\auctions\auction" & AuctionNum & ".dat"

F = FreeFile

Open Filename For Binary As #F

Put #F, , Auction(AuctionNum)

Close #F

End Sub

Public Sub CheckAuctions()

Dim i As Long

For i = 1 To 100

If Not FileExist("\data\auctions\auction" & i & ".dat") Then

Call SaveAuction(i)

End If

Next i

End Sub

Sub SaveAuction(ByVal AuctionNum As Long)

Dim Filename As String

Dim F As Long

Filename = App.path & "\data\auctions\auction" & AuctionNum & ".dat"

F = FreeFile

Open Filename For Binary As #F

Put #F, , Auction(AuctionNum)

Close #F

End Sub

Sub LoadAuctions()

Dim Filename As String

Dim F As Long

Dim i As Long

Call CheckAuctions

For i = 1 To 100

Filename = App.path & "\data\auctions\auction" & i & ".dat"

F = FreeFile

Open Filename For Binary As #F

Get #F, , Auction(i)

Close #F

Next i

End Sub

And in modGeneral in InitServer add:


ChkDir App.path & "\Data\", "auctions"

Next in sub LoadGameData() add:


Call SetStatus("Starting Up The Auction House...")

Call LoadAuctions

Next in modHandleData add:


HandleDataSub(CAddAuct) = GetAddress(AddressOf HandleAddAuction)

HandleDataSub(CCheckAuct) = GetAddress(AddressOf HandleGetAuctions)

HandleDataSub(CBid) = GetAddress(AddressOf HandleBid)

And at the bottom of the module add:


Private Sub HandleGetAuctions(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

Call SendAuctions(Index)

End Sub

Private Sub HandleAddAuction(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

Dim InvItem As Long

Dim ItemNum As Long

Dim Price As Long

Dim MaxPrice As Long

Dim Buffer As clsBuffer

Set Buffer = New clsBuffer

Buffer.WriteBytes Data()

InvItem = Buffer.ReadLong

Price = Buffer.ReadLong

MaxPrice = Buffer.ReadLong

Set Buffer = Nothing

ItemNum = GetPlayerInvItemNum(Index, InvItem)

If Price <> 0 Then

Call AddAuction(Index, ItemNum, 1, Price, MaxPrice)

Else

Call PlayerMsg(Index, "Your Price Must Be Above 0!", Red)

End If

End Sub

now in modServerTcp at the bottom add:


Public Sub SendAuctions(Optional Index As Long)

Dim Buffer As clsBuffer

Dim i As Long

Set Buffer = New clsBuffer

Buffer.WriteLong SAuct

For i = 1 To 100

	 With Auction(i)

		 Buffer.WriteString .Owner

		 Buffer.WriteLong .Item

		 Buffer.WriteLong .Price

		 Buffer.WriteLong .MaxBid

		 Buffer.WriteLong .EndDate

		 Buffer.WriteLong .Amount

		 Buffer.WriteLong .Bid

		 End With

Next i

If Index = 0 Then

	 SendDataToAll Buffer.ToArray

Else

	 SendDataTo Index, Buffer.ToArray

End If

Set Buffer = Nothing

End Sub

and in modServerLoop in Sub ServerLoop() add:


Dim LastCheckAuction As Long

At the top and


If Tick > LastCheckAuction Then

		 For i = 1 To 100

			 If Auction(i).Owner <> vbNullString Then

				 Call RemoveDeadAuction(i)

			 End If

		 Next i

			 LastCheckAuction = GetTickCount + 300000

	 End If

Somewhere in the procedure.

Now lets head over to modPlayer and in Sub JoinGame() add:


If Player(Index).BidWon > 0 Then

	 Call PlayerMsg(Index, "You Have Won A Auction!", Red)

	 Call GiveInvItem(Index, Player(Index).BidWon, Player(Index).BidWonAmount, True)

	 Player(Index).BidWon = 0

	 Player(Index).BidWonAmount = 0

End If

And:


  If Player(Index).Money > 0 Then

        Call PlayerMsg(Index, "You Reieve Money From The Auction House!", Red)

        Call GiveInvItem(Index, 1, Player(Index).Money, True)

        Player(Index).Money = 0

    End If

And last but not least add:


SAuct

with the server packets and:


CAddAuct

CCheckAuct

CBid

with the client packets.

And finally add:


Money As Long

BidWon As Long

BidWonAmount as long

To the bottom of the player rec

Congratulations, you are done.

If you notice any bugs, or find any; feel free to post below!

Addons & Extras:

if you added this tutorial before 10/18/2012 please add the following bugfix:

Anyone who has already begun the tutorial, add the following things to modAuctions server side.


Private Sub AuctionSoldOut(ByVal AuctionNum As Long, ByVal Name As String)

Dim i As Long

Dim Filename As String

Dim F As Long

Dim PlayerName As String

i = Player_HighIndex + 3

Call ClearPlayer(i)

Filename = App.path & "\data\accounts\" & Trim(Name) & ".bin"

F = FreeFile

Open Filename For Binary As #F

Get #F, , Player(i)

Close #F

Player(i).Money = Auction(AuctionNum).Bid

Filename = App.path & "\data\accounts\" & Trim(Name) & ".bin"

F = FreeFile

Open Filename For Binary As #F

Put #F, , Player(i)

Close #F

Call ClearPlayer(i)

End Sub

And in BidOnAuction replace the previous bid procedure with this:


' Lets check if we won!

If Bid >= Auction(AuctionNum).MaxBid Then

Call PlayerMsg(Index, "You Have Won " & Trim$(Item(Auction(AuctionNum).Item).Name) & " !", Red)

Call GiveInvItem(Index, Auction(AuctionNum).Item, 0, True)

If SellerIndex <> 0 Then

Call GiveInvItem(SellerIndex, 1, Auction(AuctionNum).Bid, True)

Call PlayerMsg(SellerIndex, "Your auction has sold!", Red)

Else

Call AuctionSoldOut(AuctionNum, Auction(AuctionNum).Owner)

End If

Call DestroyAuction(AuctionNum)

Call SendAuctions

Else

' We are not quite there yet ;D

Call PlayerMsg(Index, "You Are " & Auction(AuctionNum).MaxBid - Bid & " Away from winning this auction!", Red)

End If

Find

 If Player(Index).Money > 0 Then

in Sub JoinGame and replace it with:


If Player(Index).Money > 0 Then

	 Call PlayerMsg(Index, "You Reieve Money From The Auction House!", Red)

	 Call GiveInvItem(Index, 1, Player(Index).Money, True)

	 Player(Index).Money = 0

End If


Private Sub HandleBid(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

Dim Buffer As clsBuffer

Dim Bid As Long

Dim Num As Long

Set Buffer = New clsBuffer

				 Buffer.WriteBytes Data

				 With Buffer

								 Num = .ReadLong

								 Bid = .ReadLong

				 End With

				 Call BidOnAuction(Index, Bid, Num)

Set Buffer = Nothing

End Sub

work to eo 2.3? or only work to eo 3.0?

work to eo 2.3? or only work to eo 3.0?

Besides the rendering procedure part of the tutorial, yes.

I’ll show you how to do the same in DD7 if you cannot figure it out yourself.

how do I compile…?

how do I compile…?

You need to go to file create new .exe or whatever the client is called

You need to go to file create new .exe or whatever the client is called

Could you explain it a little better please? 😄

Omfg an Auction House…!? Is this for real does it even work? This has got to be hands down one of my favorite addons I have seen in a bit.

Could you make it so that when a player steps a tile it activates the action house form ? (don’t need to do the scripted tile system, just make the functions to send the packets to open the window, I suck at the Client-Server Interaction 😕

Tested it and it says:

compile error: variable not defined ( HandleDataSub(CCheckAuct) = GetAddress(AddressOf HandleGetAuctions) )

Omfg an Auction House…!? Is this for real does it even work? This has got to be hands down one of my favorite addons I have seen in a bit.

Yes it works it is actually really good

Tested it and it says:

compile error: variable not defined ( HandleDataSub(CCheckAuct) = GetAddress(AddressOf HandleGetAuctions) )

you have maybe made a error somewhere?

don’t think so, I did it calmly and with attention, maybe he might have forgotten to put it

can you add me on skype and send me your client folder I will do it for you if you want

just put the code for HandleGetAuctions() here, as easy as that xD

kk

Server Side in modHandleData

Private Sub HandleGetAuctions(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

Call SendAuctions(Index)

End Sub

Then SendAuctions is in modServerTCP and is the following incase you don’t have it

Public Sub SendAuctions(Optional Index As Long)

Dim buffer As clsBuffer

Dim i As Long

Set buffer = New clsBuffer

buffer.WriteLong SAuct

For i = 1 To 100

		 With Auction(i)

				 buffer.WriteString .Owner

				 buffer.WriteLong .Item

				 buffer.WriteLong .Price

				 buffer.WriteLong .MaxBid

				 buffer.WriteLong .EndDate

				 buffer.WriteLong .Amount

				 buffer.WriteLong .Bid

				 End With

Next i

If Index = 0 Then

		 SendDataToAll buffer.ToArray

Else

		 SendDataTo Index, buffer.ToArray

End If

Set buffer = Nothing

End Sub

could you also give the the HandleBid() ? (maybe he deleted it while editing the post…)

I have the SendAuctions(), just look at the main post and see if it’s not really there, my pc might have something wrong with it, but I see there are stuff missing

Download the completed server/client sources in the main topic and rip the pieces mission in the tutorial out from them. Thats all I did to get you the info above and you can do it on your own easier then me doing it on my own and then posting it for you to still have to do on your own….

$hit, didn’t think of that XD

Log in to reply