Auction House System

[JohnPony]

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

[http://www.mmorpgcre…tionHouseEO.rar](http://www.mmorpgcreation.com/AuctionHouseEO.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](http://www.mmorpgcreation.com/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!

[JohnPony]

**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

```

[Alerd]

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

[JohnPony]

> 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.

[Neroxx]

how do I compile…?

[highonpaint]

> how do I compile…?

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

[Neroxx]

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

Could you explain it a little better please? c:

[Nazban]

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.

[Slasheree]

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 :\

[Slasheree]

Tested it and it says:

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

[highonpaint]

> 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

[highonpaint]

> Tested it and it says:
>
> compile error: variable not defined ( HandleDataSub(CCheckAuct) = GetAddress(AddressOf HandleGetAuctions) )

you have maybe made a error somewhere?

[Slasheree]

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

[highonpaint]

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

[Slasheree]

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

[highonpaint]

kk

[Ertzel]

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
```

[Slasheree]

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

[Ertzel]

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….

[Slasheree]

$hit, didn't think of that XD

[Slasheree]

could someone help me putting this is CS:DE, I'm getting errors in the GDI part cause it's written in a different way s:

nvm, did it somehow…

[Slasheree]

houm… when I put an item for trade and then try to buy it it throws and RTE 76: Path not found, and it highlights this:

---- Le Code -----------------------------------------------------

' Outputs string to text file

Sub AddLog(ByVal Text As String, ByVal FN As String)

Dim Filename As String

Dim F As Long

If ServerLog Then

Filename = App.Path & "\data\logs\" & FN

If Not FileExist(Filename, True) Then

F = FreeFile

Open Filename For Output As #F

Close #F

End If

F = FreeFile

Open Filename For Append As #F

Print #F, Time & ": " & Text

Close #F

End If

End Sub

–-------------------------------------------------------------

[Slasheree]

why do I get the feeling it has something to do with this:

```

'Something went south, most likely a account deletion. Log it just incase

Call AddLog("Auction Failed To Find A Player And Return " & Bid & " To Them!", "")

```

Is it because I was the one who put the item for sale ?

[Slasheree]

you sure you tested it all, I comented out the Call AddLog and now it all works, but if I Place a Bid equal to the Buy out price it gives me and error and goes to the Sub ClearPlayer() ._.

[Ertzel]

I can use the auction house perfectly fine without any errors. You might want to go back to a fresh version of whatever Eclipse your using from before you added in the auction system and re-add it by ripping it out of the pre-compiled source since the tutorial is missing peaces and it looks like your current source also is.